2

私は初心者の 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.

誰でも提供できる支援は大歓迎です！

4

1 に答える 1

3

このようなもの

  • 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
于 2013-01-26T00:15:47.893 に答える