vba - 返回找到匹配的列的第 1 行
问题描述
在我的工作簿上,一个命令按钮循环遍历 A、D、G 和 J 列中的每个单元格。
如果单元格包含蓝色边框,则它正在另一个工作簿上搜索其匹配项。
如果找到该匹配项,则会将原始工作簿中的单元格值放置到第二个工作簿中,在找到匹配项的下一列中。
我有 2 个 if 语句检查下一列是否为空,如果是,则将值放在那里,如果不是,则在该行中找到下一个空单元格并放在那里。
我正在尝试将原始工作簿中的第一行(A1、D1、G1 或 J1)返回到第二个工作簿上新放置的值的相邻列中。
例子:
- 在工作簿 1 中,名称“John Doe”和“Jane Doe”在 A 列中有蓝色边框。
- 在工作簿 2 中,在 A 列第 123 行找到“John Doe”,在 A 列第 250 行找到“Jane Doe”。
- 宏将“John Doe”放在 B 列第 123 行,将“Jane Doe”放在 B 列第 250 行(假设 B123 和 B250 中的单元格为空)。
从工作簿 1 中,我还想将单元格值放入 A1 - 到工作簿 2:C 列,第 123 行和第 250 行。
但我想同时为 Columns ADGJ 执行此操作(我下面的代码中的 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
推荐阅读
- r - 按 ASCII 顺序排列 R 中的列
- scala - 有没有办法将 parquet 分区下的所有文件读取到单个 spark 分区上?
- python - 矩阵的小调
- ffmpeg - 创建 PIP 视频,同时为画中画添加透明度?
- javascript - 使用节点 js 的 ajax 响应
- c++ - 在 C++ 中使用 Tesseract OCR 时如何启用“安静模式”?
- c++ - C ++将函数的结果传递给另一个函数
- android-source - 将移动网络添加到 Android 设备
- mysql - 如何在本月 1 日到上月 17 日之间进行选择
- javascript - 将相同函数的结果添加到没有临时变量的多个变量中