Question

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

使用下面其他帖子中的代码我将其修改为启动器（可能是错误的方法），我需要

在工作表 Test 中循环遍历整个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

循环和计数excel包含数据的单元格，然后循环多次执行的操作

1 个答案: