我想從位于目錄中的檔案中提取資料，但順序正確。
我在這里找到了一些東西：
結果一直很好，但似乎根本沒有順序。有些檔案沒有某些記錄，這可以在影像中看到。但是，空格應該在中間的某個地方。我該如何解決？
更新：附表1
uj5u.com熱心網友回復：
將源資料作業簿的檔案名記錄在一個備用列中，然后在最后對它的資料進行排序。
Sub CopyData()
Const COL_SORT = "K"
Dim wbSource As Workbook, datSource As Worksheet
Dim datTarget As Worksheet
Dim strFilePath, strfile As String
Dim strPath As String, n As Long
Set datTarget = ThisWorkbook.Sheets("Survey")
strPath = GetPath
Application.ScreenUpdating = False
If Not strPath = vbNullString Then
strfile = Dir$(strPath & "Z*.xlsx", vbNormal)
Do While Not strfile = vbNullString
' parse file for data
Set wbSource = Workbooks.Open(strPath & strfile, ReadOnly:=True)
Set datSource = wbSource.Sheets("Sheet1")
Call Copy_Data(datSource, datTarget, COL_SORT)
wbSource.Close False
strfile = Dir$()
n = n 1
Loop
End If
' sort result
With datTarget
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=.Cells(1, COL_SORT), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange datTarget.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Application.ScreenUpdating = True
MsgBox n & " files processed", vbInformation
End Sub
Sub Copy_Data(ByRef datSource As Worksheet, datTarget As Worksheet, ColSort As String)
'QUESTION 1,2,4
Dim qu(4), q As Long, c As Long
qu(1) = "*PM is required*"
qu(2) = "*be lifted*"
qu(3) = ""
qu(4) = "*RAG Status*"
Dim rngSearch As Range, rngFound As Range
Dim lrow As Long
With datSource
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngSearch = datSource.Range("A1:A" & lrow)
End With
' qu 1,2,4
For q = 1 To 4
c = q 4 ' Q1=E, Q2=F etc
If qu(q) <> "" Then 'skip qu 3
Set rngFound = rngSearch.Find(What:=qu(q), Lookat:=xlPart, LookIn:=xlValues)
With datTarget
lrow = .Cells(.Rows.Count, c).End(xlUp).Row 1
If rngFound Is Nothing Then
.Cells(lrow, c) = "Not Found" ' blank
Else
rngFound.Copy
.Cells(1, c).PasteSpecial xlPasteValuesAndNumberFormats
rngFound.Offset(1).Copy
.Cells(lrow, c).PasteSpecial xlPasteValuesAndNumberFormats
End If
.Cells(lrow, ColSort) = datSource.Parent.Name
End With
End If
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qita/391129.html
上一篇：在陣列中查找存盤范圍值的列號