我有一个包含4个工作表的工作簿，所有工作表都在第5行有日期，在D列说明。在日期旁边的单元格中，该人将放置'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
它显示所有工作表数据，但我需要的是，如果在日期旁边的第5行中输入了ET或LT，则它会将第37行中的相应数据添加到摘要表中。如果它只是数字，则跳过它并找到下一个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
答案 0 :(得分：0)
我不完全明白你要做什么。您的代码将范围完全复制到摘要表，但看起来您想要转换它们的结果 - 数字/日期在行中向下而不是跨行。另外，你说＆＃34;日期＆＃34;但是在摘要表上有数字1-9，并且在Sheet1和Sheet2上有数字1-9。我也分不清楚哪一列＆＃34;对应＆＃34;第37行的值是。
因此，此代码可能不适合您，因为它基于以下假设：1）您不希望D5：AH5从每张纸张准确粘贴到汇总表上; 2）因为他们是你提到的唯一标准，＆＃34; ET＆＃34;和＆＃34; LT＆＃34;是＆＃34; date＆＃34;旁边的唯一代码你关心的; 3）第37行中的值与＆＃34; date＆＃34;在同一列中; 4）＆＃34; 1ET＆＃34;和＆＃34; 2LT＆＃34;在您的数据中代表＆＃34; 1＆＃34;在D5，＆＃34; ET＆＃34;在E5中，＆＃34; 2＆＃34;在F5中，＆＃34; LT＆＃34;在G5中，依此类推; 5）因为您使用了数字1-9，所以通过采用＆＃34; date＆＃34;来确定从第37行粘贴值的行。并添加1.如果您有实际日期，则需要更改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
答案 1 :(得分：0)
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
这可以通过页面上的摘要表而不是垂直方式实现我想要的一切。