1

我是一个完整的 VBA 新手，但设法拼凑了以下内容，这对于我已将代码分配给命令按钮的工作表来说很好。我的问题是我的工作表有超过 3000 行，我真的不想创建 3000 个按钮。

我目前的想法是让脚本搜索一系列单元格以查找特定条件（即 TRUE），然后将我的原始代码作为与条件匹配的每个单元格的下标运行。我尝试创建一个循环来匹配正在搜索的条件，但不知道如何将结果设置为活动单元格。

谁能给我一些关于如何实现这一目标或提出更好解决方案的指示？谢谢。

Sub Send_FWU_to_E_Drive()

Dim aTemp As String
Dim bTemp As String
Dim cTemp As String
Dim dTemp As String
Dim eTemp As String
Dim subdir As String

aTemp = "c:\test\"
bTemp = "E:\romdata\"
cTemp = ActiveCell.Offset(, -5) & ".fwu"
dTemp = ActiveWorkbook.path
eTemp = "\Firmware files"
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu"

MsgBox "The path of the active workbook is " & dTemp & subdir

If Dir(dTemp & subdir) = "" Then
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card."
Exit Sub
End If

MsgBox "The file " & cTemp & " is being copied to " & bTemp

If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata"

If Dir(bTemp & "nul") = "" Then
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory."
Exit Sub

End If

FileCopy dTemp & subdir, bTemp & cTemp

End Sub
4

1 回答 1

2

首先修改您的函数以接受范围参数，我们将其称为单元格：

Sub Send_FWU_to_E_Drive(cell as Excel.Range)

然后ActiveCell将该 Sub 中的所有引用更改为cell.

下面的子循环遍历活动表 B 列中的每个单元格，如果为 TRUE，则使用该行 A 列中的单元格调用您的例程。因此，您在代码中的偏移量Send_FWU_to_E_Drive都与 A 列中的单元格相关。此代码未经测试，但应该接近：

Sub Test
Dim Cell as Excel.Range
Dim LastRow as Long

With ActiveSheet
    LastRow = .Range("A" & .Rows.Count).End(xlup).Row
    For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B
        If Cell.Value = TRUE Then
            Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell
        End If
    Next Cell
End With
End Sub

编辑：根据@Siddharth 的建议，这里有一个 Find/FindNext 版本：

Sub Test()
Dim cell As Excel.Range
Dim LastRow As Long
Dim SearchRange As Excel.Range
Dim FirstFindAddress As String

With ActiveSheet
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set SearchRange = .Range("B2:B" & LastRow)  'Search for TRUE in column B
    Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1))
    If Not cell Is Nothing Then
        FirstFindAddress = cell.Address
        Send_FWU_to_E_Drive cell.Offset(0, -1)
        Do
            Send_FWU_to_E_Drive cell.Offset(0, -1)
            Set cell = SearchRange.FindNext(after:=cell)
        Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress
    End If
End With
End Sub
于 2013-04-15T13:43:34.723 回答