在多个工作表中search多个单元格，然后在汇总表中复制另一个单元格值
我有一个工作簿，有4个工作表，所有的date都在第5行，在D列表示。在date旁边的单元格中，人们可以放置'ET'，'LT'，'EG'，'1ET' '2LT'，否则他们会留空。
我正在阅读VBA是如何工作的，但是我刚开始这么做很新。
我到目前为止：
Sub test() Dim summarySheet As Worksheet Dim sh As Worksheet Dim j As Integer 'change "Summary" to the sheet name that is true for you' Set summarySheet = ThisWorkbook.Worksheets("Summary") 'number of first row where need to paste in summary sheet' j = 2 'loop throught all sheets' For Each sh In ThisWorkbook.Worksheets If sh.Name <> summarySheet.Name Then summarySheet.Range("B" & j & ":AF" & j).Value = _ sh.Range("D5:AH5").Value j = j + 1 End If Next End Sub 它显示所有的工作表数据，但是我需要的是如果在date旁边的行5中input了ET或LT，那么它将来自行37的相应数据添加到汇总表中。 如果只是数字，那就跳过这个数字，find下一个ET或LT
EG Sheet 1 Row 5 1ET 2LT 3ET 4 5 6 7ET 8ET =========================== Row 37 16 32 2 45 67 Sheet 2 Row 5 1 2 3LT 4ET 5ET 6LT 7 8LT =========================== Row 37 23 33 13 22 34 SUMMARY SHEET ET LT 1 16 2 32 3 2 23 4 33 5 13 6 7 45 8 67 34 9 Etc
我不完全明白你在做什么。 您的代码将范围完全复制到汇总表中，但看起来像您希望调换它们的结果 – 使数字/date沿行而不是跨行。 此外，你会说“date”，但在汇总表上有1-9的数字，在Sheet1和Sheet2上有1-9的数字。 我也不能告诉哪一列“对应”的价值在第37行。
因此，这段代码可能并不完全适用于您，因为它基于以下假设：1）您不希望每张纸上的D5：AH5都粘贴到汇总表上; 2）因为它们是你提到的唯一标准，所以“ET”和“LT”是你所关心的“date”之后的唯一代码; 3）第37行的值与“date”在同一列; 4）数据中的“1ET”和“2LT”分别代表D5中的“1”，E5中的“ET”，F5中的“2”，G5中的“LT”等等。 5）由于您使用了数字1-9，因此粘贴第37行的值的行是通过取“date”并加1.确定的。如果您有实际date，则需要更改您的pasteRow的逻辑。
Sub test() Dim summarySheet As Worksheet Dim sh As Worksheet Dim searchRng As Range Dim dateCell As Range Dim pasteCol As Integer Dim copyRow As Integer Dim pasteRow as integer 'change "Summary" to the sheet name that is true for you' Set summarySheet = ThisWorkbook.Worksheets("Summary") 'the "corresponding row" to copy copyRow = 37 'loop throught all sheets' For Each sh In ThisWorkbook.Worksheets If sh.Name <> summarySheet.Name Then 'set the range that we are using Set searchRng = sh.Range("D5:AH5") For Each cell In searchRng 'loop through the range and check if it has the desired key value If cell.Value = "ET" Or cell.Value = "LT" Then 'set which column on SummarySheet will get the value If cell.Value = "ET" Then 'column B, ie column #2 pasteCol = 2 ElseIf cell.Value = "LT" Then 'column C, ie column #3 pasteCol = 3 End If 'set the cell containing the date - assumes is to the left of our key value cell Set dateCell = cell.Offset(0, -1) 'set row # to paste to, ie if the value in dateCell is 9, then paste to row 10 pasteRow = dateCell.Value + 1 'set the value on summarySheet using the value in dateCell + 1 for our row number 'and dateCell's column with copyRow to get our "corresponding" value summarySheet.Range(Cells(pasteRow, pasteCol).Address).Value = _ sh.Range(Cells(copyRow, dateCell.Column).Address) End If Next cell End If Next End Sub
根据实际电子表格中的新信息进行编辑：
Sub test() Dim summarySheet As Worksheet Dim sh As Worksheet Dim searchRng As Range Dim dateNum As Integer Dim pasteCol As Integer Dim copyRow As Integer Dim pasteRow As Integer Dim c As Range Dim oldVal As Integer 'change "Summary" to the sheet name that is true for you' Set summarySheet = ThisWorkbook.Worksheets("Summary") 'clear current value on summarySheet summarySheet.Range("C3:D33").Value = "" 'loop throught all sheets' For Each sh In ThisWorkbook.Worksheets If sh.Name <> summarySheet.Name Then 'set the range that we are using Set searchRng = sh.Range("D5:AH5") 'the "corresponding row" to copy With sh.Range("C:C") Set c = .Find("Number of staff") If Not c Is Nothing Then copyRow = c.Row End If End With For Each cell In searchRng 'loop through the range and check if it has the desired key value If cell.Value Like "*ET" Or cell.Value Like "*LT" Then 'set which column on SummarySheet will get the value If cell.Value Like "*ET" Then 'column C, so column #3 pasteCol = 3 ElseIf cell.Value Like "*LT" Then 'column D, so column #4 pasteCol = 4 End If 'get the date from the cell dateNum = Val(cell.Value) If dateNum = 0 Then MsgBox "Sheet " & sh.Name & " cell " & cell.Address & " is missing date. Please fill in and run again." Exit Sub End If 'set row # to paste to, ie if the value in dateCell is 9, then paste to row 11 pasteRow = dateNum + 2 'set the value on summarySheet using cell's column with copyRow to get our "corresponding" value oldVal = summarySheet.Range(Cells(pasteRow, pasteCol).Address).Value summarySheet.Range(Cells(pasteRow, pasteCol).Address).Value = _ sh.Range(Cells(copyRow, cell.Column).Address).Value + oldVal End If Next cell End If Next MsgBox "Complete" End Sub
Option Explicit Private Sub Worksheet_Activate() Dim r As Range, rng As Range, snRow As Range, x As Integer ActiveSheet.Range("C4:AG5").ClearContents For x = 1 To Sheets.Count If Sheets(x).Name <> "Summary" Then With Sheets(Sheets(x).Name) With .Range("C:C") Set snRow = .Find("Number of staff", LookIn:=xlValues, lookat:=xlWhole) End With Set rng = .Range("D5", "AH5") For Each r In rng If InStr(1, r.Value, "LT") > 0 Then Sheets("Summary").Cells(5, r.Column - 1) = .Cells(snRow.Row, r.Column).Value ElseIf InStr(1, r.Value, "ET") > 0 Then Sheets("Summary").Cells(4, r.Column - 1) = .Cells(snRow.Row, r.Column).Value End If Next End With End If Next End Sub
这样可以实现我想要的所有内容，而不是纵向排列页面。