我收到了一份帶有多張作業表的 Excel 作業簿。在每個作業表中，有 n 行，每個客戶一個，不同的列代表有關每個客戶的不同資訊。
問題是我的任務是創建一個大作業表，其中包含我提供的所有作業表中的所有資訊，但列的順序并不完全相同，有些作業表沒有所有列。我無法創建一個回圈來獲取每張作業表并將其復制到主作業表的底部，因為由于它們的順序以及某些作業表中缺少一些列，因此列不會對齊。
所有作業表中的所有列都具有相同的名稱，因為“名稱”列可能不在同一個位置，但始終具有相同的標題。與資料型別和格式相同，它們的順序不同，也不是全部都存在，但對于每個作業表，存在的作業表具有相同的資料型別和格式。
編輯：這是我自己制作的資料示例，不使用帶有客戶姓名和資訊的真實資料。第 1 行是字串格式的標題（“a”、“b”等），其余是占位符數字。
[ 
上圖是每張表中帶有標題的資料。
（sh1 = sheet1 中的資料，sh2 = sheet2 中的資料，依此類推）。
從影像示例中，具有最多列的標題在 sheet4 中。所以，這個標題將是輸出表的主標題。
名為“輸出”的作業表中的預期結果如下圖所示：
如果這就是你的意思：
Sub test()
Dim rg As Range: Dim cell As Range
Dim sh As Worksheet: Dim ws As Worksheet
Dim cnt As Long: Dim cc As Long: Dim LR As Long
cnt = 0
For Each sh In Sheets
With sh
cc = .Range("A1", .Range("A1").End(xlToRight)).Columns.Count
If cc > cnt Then cnt = cc: Set ws = sh
End With
Next
With Sheets.Add
.Name = "Output"
ws.Range("A1", ws.Range("A1").End(xlToRight)).Copy Destination:=.Range("A1")
Set rg = .Range("A1", .Range("A1").End(xlToRight))
End With
For Each sh In Sheets
If sh.Name <> "Output" Then
LR = ActiveSheet.UsedRange.Rows.Count 1
For Each cell In rg
Set c = sh.Rows(1).Find(cell.Value, lookat:=xlWhole)
If Not c Is Nothing Then Cells(LR, cell.Column).Resize(Range(c.Offset(1, 0), c.End(xlDown)).Rows.Count, 1).Value = Range(c.Offset(1, 0), c.End(xlDown)).Value
Next
End If
Next
End Sub
sub中有三個回圈。
第一個回圈是獲取使用最多列的標題。
所以在這種情況下，第一個回圈中的 ws 變數將是 sheet4（6 列標題）。
然后它創建一個新作業表，將其命名為“輸出”，
復制 ws 中的標題并將其粘貼為作業表“輸出”標題，
然后它為作業表“輸出”中的標題創建一個范圍作為 rg 變數。
第二個回圈是回圈每個未命名為“輸出”的作業表，
創建一個變數 LR 以查找作業表“輸出” 1 中使用的最后一行，
然后在第二個回圈內是第三個回圈，回圈每個標題列名稱在 rg.
對于 rg 中的每個標題列名稱，它會檢查，如果該標題名稱在回圈表（c 變數）中，那么它將復制回圈表的該標題列名稱的資料并將其粘貼到相同的標題列名稱在“輸出”表上。
uj5u.com熱心網友回復：
我不知道我是否明白你想要什么，但我試圖為此撰寫代碼：
Sub Generate_report()
Application.ScreenUpdating = False
Dim column_v As Integer
Dim Plan_v As Worksheet
Dim Plan_final As Worksheet
Set Plan_final = Sheets("Final")
For Each Plan_v In Worksheets
If Plan_v.Name <> "Final" Then
Plan_v.Select
rng_headers = Range(Range("A1"), Range("A1").End(xlToRight))
For i = 1 To UBound(rng_headers, 2)
Header = rng_headers(1, i)
Column_final = Find_column_final(Header, Plan_final)
column_v = i
Plan_v.Select
Last_row_v = Last_row(column_v, Plan_v)
Range(Cells(2, column_v), Cells(Last_row_v, column_v)).Copy
Plan_final.Select
Cells(Cells(1000000, Column_final).End(xlUp).Offset(1, 0).Row, Column_final).Select
ActiveSheet.Paste
Next
End If
Next
End Sub
Function Last_row(Column_index As Integer, plan As Worksheet)
Last_row = plan.Cells(1000000, Column_index).End(xlUp).Row
End Function
Function Find_column_final(Header_value, plan As Worksheet)
plan.Select
rng_headers = Range(Range("A1"), Range("A1").End(xlToRight))
For i = 1 To UBound(rng_headers, 2)
If Header_value = rng_headers(1, i) Then
Find_column_final = i
Exit Function
End If
Next
Find_column_final = i 1
End Function
您只需要在第一行中使用所有可能的標題填寫“最終”計劃。
注意：此代碼將保留最終作業表中的空白單元格。
希望這有所幫助。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/489175.html