如何解决vba重复代码直到a列为空
如何创建重复代码直到 columna 值为空的代码
这是我的代码。
Sheets("sheet4").Select
Sheets("sheet4").Range("$A$1:$AG$2336").AutoFilter Field:=1,Criteria1:= _
Sheets("sheet1").Range("a3")
Sheets("sheet4").Range("a1:ad1").find(Sheets("sheet1").Range("L3").Value).offset(2,0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.offset(2,0).Select
Loop
Selection.Copy Sheets("sheet1").Range("b3")
Sheets("sheet1").Select
End Sub
我需要向下复制我的选择,直到 a 列结束(我的意思是 a 列中的单元格将为空)。你能帮我吗??
解决方法
用变量替换 3 并将代码放入循环中。
Option Explicit
Sub macro()
Dim wb As Workbook
Dim ws1 As Worksheet,ws4 As Worksheet
Dim colA,colL,iRow As Long
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws4 = wb.Sheets("Sheet4")
ws4.Select
iRow = 3
colA = ws1.Cells(iRow,"A")
Do While Len(colA) > 0
colL = ws1.Cells(iRow,"L")
If Len(colL) > 0 Then
' apply filter
ws4.Range("A1:AG2336").AutoFilter Field:=1,Criteria1:=colA
' copy filtered data
ws4.Range("A1:AD1").Find(colL).Offset(2,0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(2,0).Select
Loop
Selection.Copy ws1.Range("B" & iRow)
'
End If
' next value in col A
iRow = iRow + 1
colA = ws1.Cells(iRow,"A")
Loop
MsgBox iRow - 3 & " rows scanned on " & ws1.Name,vbInformation
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。