Return 找到匹配项的列的第 1 行
Return Row 1 of Column where match was found
在我的工作簿上,命令按钮循环遍历 A、D、G 和 J 列中的每个单元格。
如果单元格包含蓝色边框,则它正在另一个工作簿中搜索它的匹配项。
如果找到该匹配项,它会将原始工作簿中的单元格值放置到第二个工作簿中,在找到匹配项的下一列中。
我有 2 个 if 语句检查下一列是否为空,如果是则将值放在那里,如果不是则找到该行中的下一个空单元格并放在那里。
我正在尝试 return 将原始工作簿的第一行(A1、D1、G1 或 J1)添加到第二个工作簿中新放置的值的相邻列中。
示例:
- 在工作簿 1 中,姓名“John Doe”和“Jane Doe”在 A 列中有蓝色边框。
- 在工作簿 2 中,“John Doe”出现在 A 列第 123 行,“Jane Doe”出现在 A 列第 250 行。
- 宏将“John Doe”放入 B 列第 123 行,将“Jane Doe”放入 B 列第 250 行(假设 B123 和 B250 中的单元格为空)。
我还想将工作簿 1 中的单元格值放入工作簿 2 的 A1 中:C 列,第 123 行和第 250 行。
但我想同时对 A D G J 列执行此操作(下面代码中的 rr3dest 是我试图将此值设置为的值,我知道它现在没有设置任何值)。
Private Sub CommandButton3_Click()
Dim testWS As Worksheet
Dim testRange As Range, idCella As Range
Dim alastRow2 As Long, resultM As Integer
Dim rr2dest As Range, rr3dest As Range
Set testWS = Workbooks("Test.xlsx").Worksheets("October") 'set the 2nd workbook as testWS
Set testRange = testWS.Columns(1) 'searching only column A on testWS (2nd workbook)
alastRow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A that has data on current workbook
dlastRow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "D").End(xlUp).Row
glastrow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "G").End(xlUp).Row
jlastrow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "J").End(xlUp).Row
For Each idCella In Worksheets("Reruns To Pull").Range("A1:A" & alastRow2 & ",D1:D" & dlastRow2 & ",G1:G" & glastrow2 & ",J1:J" & jlastrow2).Cells 'for each cell in Column A on current workbook (eventually I want to loop through Column A, D, G, J. All will be variable ranges)
If idCella.Borders.Color = RGB(0, 0, 192) Then 'On current workbook, if cells in Col A borders.color = blue then
If Not IsError(Application.Match(idCella.Value, testRange, 0)) Then 'find exact match on Test.xlsx (2nd workbook) and store in variable resultM
resultM = (Application.Match(idCella.Value, testRange, 0))
If IsEmpty(testWS.Range("A" & CStr(resultM)).Offset(0, 1)) Then ' if resultM.offset(0,1) is empty then set destination to .offset(0,1)
Set rr2dest = testWS.Range("A" & CStr(resultM)).Offset(0, 1)
rr2dest.Value = idCella.Value
rr2dest.Interior.Color = idCella.Interior.Color
rr2dest.Borders.Color = idCella.Borders.Color
rr2dest.Borders.Weight = idCella.Borders.Weight
Set rr3dest = testWS.Range("A" & CStr(resultM)).Offset(0, 2)
ElseIf Not IsEmpty(testWS.Range("A" & CStr(resultM)).Offset(0, 1)) Then ' if resultM.offset(0,1) is not empty then set destination to .end(xltoright).offset(0,1)
Set rr2dest = testWS.Range("A" & CStr(resultM)).End(xlToRight).Offset(0, 1)
rr2dest.Value = idCella.Value
rr2dest.Interior.Color = idCella.Interior.Color
rr2dest.Borders.Color = idCella.Borders.Color
rr2dest.Borders.Weight = idCella.Borders.Weight
End If
End If
End If
Next idCella
testWS.Range("A2:M80").WrapText = True
testWS.Columns("A:M").HorizontalAlignment = xlCenter
testWS.Columns("A:M").VerticalAlignment = xlVAlignCenter
End Sub
已编译但未测试:
Private Sub CommandButton3_Click()
Dim testWS As Worksheet, pullWS As Worksheet
Dim testRange As Range, idCella As Range
Dim arrSourceCols, col, v, m, c As Range
Set testWS = Workbooks("Test.xlsx").Worksheets("October") 'set the 2nd workbook as testWS
Set testRange = testWS.Columns(1) 'searching only column A on testWS (2nd workbook)
Set pullWS = ThisWorkbook.Worksheets("Reruns To Pull")
arrSourceCols = Array("A", "D", "G", "J") 'columns to be scanned and matched
For Each col In arrSourceCols 'loop source columns
For Each idCella In pullWS.Range(pullWS.Cells(1, col), _
pullWS.Cells(Rows.Count, col).End(xlUp)).Cells
If idCella.Borders.Color = RGB(0, 0, 192) Then
v = idCella.Value 'value to look for
m = Application.Match(v, testRange, 0) 'match?
If Not IsError(m) Then
Set c = testWS.Cells(m, Columns.Count).End(xlToLeft).Offset(0, 1) 'get empty cell
c.Value = v 'put the matched value
CopyFormats idCella, c 'transfer formatting
c.Offset(0, 1).Value = pullWS.Cells(1, col).Value 'put the header from the column
End If 'matched
End If 'blue borders
Next idCella
Next col
testWS.Range("A2:M80").WrapText = True
testWS.Columns("A:M").HorizontalAlignment = xlCenter
testWS.Columns("A:M").VerticalAlignment = xlVAlignCenter
End Sub
Sub CopyFormats(cFrom As Range, cTo As Range)
With cTo
.Interior.Color = cFrom.Interior.Color
.Borders.Color = cFrom.Borders.Color
.Borders.Weight = cFrom.Borders.Weight
End With
End Sub
在我的工作簿上,命令按钮循环遍历 A、D、G 和 J 列中的每个单元格。
如果单元格包含蓝色边框,则它正在另一个工作簿中搜索它的匹配项。
如果找到该匹配项,它会将原始工作簿中的单元格值放置到第二个工作簿中,在找到匹配项的下一列中。
我有 2 个 if 语句检查下一列是否为空,如果是则将值放在那里,如果不是则找到该行中的下一个空单元格并放在那里。
我正在尝试 return 将原始工作簿的第一行(A1、D1、G1 或 J1)添加到第二个工作簿中新放置的值的相邻列中。
示例:
- 在工作簿 1 中,姓名“John Doe”和“Jane Doe”在 A 列中有蓝色边框。
- 在工作簿 2 中,“John Doe”出现在 A 列第 123 行,“Jane Doe”出现在 A 列第 250 行。
- 宏将“John Doe”放入 B 列第 123 行,将“Jane Doe”放入 B 列第 250 行(假设 B123 和 B250 中的单元格为空)。
我还想将工作簿 1 中的单元格值放入工作簿 2 的 A1 中:C 列,第 123 行和第 250 行。
但我想同时对 A D G J 列执行此操作(下面代码中的 rr3dest 是我试图将此值设置为的值,我知道它现在没有设置任何值)。
Private Sub CommandButton3_Click()
Dim testWS As Worksheet
Dim testRange As Range, idCella As Range
Dim alastRow2 As Long, resultM As Integer
Dim rr2dest As Range, rr3dest As Range
Set testWS = Workbooks("Test.xlsx").Worksheets("October") 'set the 2nd workbook as testWS
Set testRange = testWS.Columns(1) 'searching only column A on testWS (2nd workbook)
alastRow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A that has data on current workbook
dlastRow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "D").End(xlUp).Row
glastrow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "G").End(xlUp).Row
jlastrow2 = Worksheets("Reruns To Pull").Cells(Rows.Count, "J").End(xlUp).Row
For Each idCella In Worksheets("Reruns To Pull").Range("A1:A" & alastRow2 & ",D1:D" & dlastRow2 & ",G1:G" & glastrow2 & ",J1:J" & jlastrow2).Cells 'for each cell in Column A on current workbook (eventually I want to loop through Column A, D, G, J. All will be variable ranges)
If idCella.Borders.Color = RGB(0, 0, 192) Then 'On current workbook, if cells in Col A borders.color = blue then
If Not IsError(Application.Match(idCella.Value, testRange, 0)) Then 'find exact match on Test.xlsx (2nd workbook) and store in variable resultM
resultM = (Application.Match(idCella.Value, testRange, 0))
If IsEmpty(testWS.Range("A" & CStr(resultM)).Offset(0, 1)) Then ' if resultM.offset(0,1) is empty then set destination to .offset(0,1)
Set rr2dest = testWS.Range("A" & CStr(resultM)).Offset(0, 1)
rr2dest.Value = idCella.Value
rr2dest.Interior.Color = idCella.Interior.Color
rr2dest.Borders.Color = idCella.Borders.Color
rr2dest.Borders.Weight = idCella.Borders.Weight
Set rr3dest = testWS.Range("A" & CStr(resultM)).Offset(0, 2)
ElseIf Not IsEmpty(testWS.Range("A" & CStr(resultM)).Offset(0, 1)) Then ' if resultM.offset(0,1) is not empty then set destination to .end(xltoright).offset(0,1)
Set rr2dest = testWS.Range("A" & CStr(resultM)).End(xlToRight).Offset(0, 1)
rr2dest.Value = idCella.Value
rr2dest.Interior.Color = idCella.Interior.Color
rr2dest.Borders.Color = idCella.Borders.Color
rr2dest.Borders.Weight = idCella.Borders.Weight
End If
End If
End If
Next idCella
testWS.Range("A2:M80").WrapText = True
testWS.Columns("A:M").HorizontalAlignment = xlCenter
testWS.Columns("A:M").VerticalAlignment = xlVAlignCenter
End Sub
已编译但未测试:
Private Sub CommandButton3_Click()
Dim testWS As Worksheet, pullWS As Worksheet
Dim testRange As Range, idCella As Range
Dim arrSourceCols, col, v, m, c As Range
Set testWS = Workbooks("Test.xlsx").Worksheets("October") 'set the 2nd workbook as testWS
Set testRange = testWS.Columns(1) 'searching only column A on testWS (2nd workbook)
Set pullWS = ThisWorkbook.Worksheets("Reruns To Pull")
arrSourceCols = Array("A", "D", "G", "J") 'columns to be scanned and matched
For Each col In arrSourceCols 'loop source columns
For Each idCella In pullWS.Range(pullWS.Cells(1, col), _
pullWS.Cells(Rows.Count, col).End(xlUp)).Cells
If idCella.Borders.Color = RGB(0, 0, 192) Then
v = idCella.Value 'value to look for
m = Application.Match(v, testRange, 0) 'match?
If Not IsError(m) Then
Set c = testWS.Cells(m, Columns.Count).End(xlToLeft).Offset(0, 1) 'get empty cell
c.Value = v 'put the matched value
CopyFormats idCella, c 'transfer formatting
c.Offset(0, 1).Value = pullWS.Cells(1, col).Value 'put the header from the column
End If 'matched
End If 'blue borders
Next idCella
Next col
testWS.Range("A2:M80").WrapText = True
testWS.Columns("A:M").HorizontalAlignment = xlCenter
testWS.Columns("A:M").VerticalAlignment = xlVAlignCenter
End Sub
Sub CopyFormats(cFrom As Range, cTo As Range)
With cTo
.Interior.Color = cFrom.Interior.Color
.Borders.Color = cFrom.Borders.Color
.Borders.Weight = cFrom.Borders.Weight
End With
End Sub