循环并计算包含数据的excel单元格，然后循环多次执行一个动作

Question

我是一名新手 vba 编码器，迫切需要一些帮助。

使用下面另一篇文章中的代码，我已将其修改为初学者（可能是错误的方法），我需要

• 循环遍历工作表测试中的整个 A 列。
• 计算该区域中包含数据的单元格数。
• 使用该计数，我需要将文件复制到一个目录中，该目录多次将循环中的下一个数字附加到文件名中。

例如，如果我发现 210 个包含数据的单元格，我想将这个文件 C:\image\test.tif 复制 210 次到 C:\temp\imagecopy\test (1).tif，然后是 C:\temp\imagecopy\test (2).tif" 和 C:\temp\imagecopy\test (3).tif 等等。

但我真的不知道如何实现这一点。这是我目前所拥有的。

Sub CountTextPatterns()
Dim rngToCheck As Range
Dim cl As Range

Set rngToCheck = Range("A1:A10000") //Set up the range that contains the text data

Dim nothingHere As Integer
Set nothingHere = ""


//Loop through range, match cell contents to pattern, and increment count accordingly
For Each cl In rngToCheck
    If nothingHere.Test(cl) Then
        nothingHere = nothingHere+ 1
    End If
Next

//For anything that isn't a letter or number, simply subtract from the and total row count
cntNumber = rngToCheck.Rows.Count - cntnothingHere

End Sub

//So at this point I believe I should have the total cells that are not blank.  Now I need to execute a file copy action that many times using the logic mentioned at the top. 

任何人都可以提供任何帮助，我们将不胜感激！

Answer 1

类似的东西

• 避免循环计算单元格计数，改用Application.CountA
• 使用FileCopy 增量复制文件

您没有指定输出目录是否已经存在，要复制的文件名是用户指定的还是硬编码的等等。所以下面的代码可能会受益于测试/错误处理这些条件

代码

Sub CopyEm()
    Dim ws As Worksheet
    Dim strIn As String
    Dim strOut As String
    Dim strFile As String
    Dim strLPart As String
    Dim strRPart As String
    Dim lngCnt As Long
    Dim lngFiles As Long
    Set ws = Sheets("Test")
    lngCnt = Application.CountA(ws.Columns("A"))
    If lngCnt = 0 Then Exit Sub
    strIn = "C:\image\"
    strOut = "C:\imagecopy\"
    strFile = "test.tif"
    'extract string portions of the file name and type outside the copy loop 
    strLPart = Left$(strFile, InStr(strFile, ".") - 1)
    strRPart = Right$(strFile, Len(strFile) - Len(strLPart))
    For lngFiles = 1 To lngCnt
        FileCopy strIn & strFile, strOut & strLPart & "(" & lngFiles & ")" & strRPart
    Next
End Sub