1

我是一家公司的实习生，他们在那里做大量的 DCR 和电感读数，并拥有文本文件中的所有值。我设法使用 VBA 将这些文本文件导入到 Excel 电子表格中，但是现在我需要开始处理这些数据。我正在尝试编写一些代码，它将遍历整个列并搜索字符串“** DCR”，然后给我单元格偏移量（1,3）中的数据，复制，然后将其粘贴到同一工作簿中的不同范围。我已经编写了代码 where is 搜索字符串的第一个实例，然后将我需要的数据复制并粘贴到该范围中，但随后它就停止了。我编写的 Do Loop 代码给了我一个无限循环并且不起作用。到目前为止，这是我的代码。

Sub Button2_Click()

Dim rng1 As Range
Dim strSearch As String
strSearch = "**DCR"

Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
    rng1.Offset(1, 3).Copy
    Range("N11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O11").Select
    Do
        Set rng1 = Range("A:A").FindNext(rng1)
    Loop
End If

End Sub

谁能告诉我我错过了什么和/或做错了什么。非常感谢！

4

2 回答 2

0

你需要移动 Do-Loop：基本上只要有结果就循环，没有结果就退出。但是代码仍然会循环，因为 findNext 会继续寻找下一个结果，即使它已经找到了。所以你必须保持跟踪你的第一个结果。

您可能希望增加您复制到的位置。

请记住，复制和粘贴在 excel 中是昂贵的，更好更快的方法是复制单元格值。

       暗淡 strSearch 作为字符串
       Dim rng1 As Excel.Range
       将 firstrng1 调暗为 Excel.Range
       将 rowNumber 暗淡为整数
       行号 = 11;
       strSearch = "**DCR"

       设置 rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)
       如果 rng1 什么都不是，则退出 Sub

       设置 firstrng1 = rng1
       做
          Range("N" & rowNumber).Value = rng1.Offset(1, 3)
          行号 = 行号 + 1   
          设置 rng1 = Range("A:A").FindNext(rng1)
          If rng1.Address = firstrng1.Address Then Exit Do
       环形
于 2013-07-19T15:56:11.163 回答
0

尝试这个...

Sub Button2_Click()

Const DCR As String = "**DCR"

Dim rngSearch As Range
Set rngSearch = ActiveSheet.Range("A:A")

Dim rngFoundFirst As Range

Set rngFoundFirst = rngSearch.Find(DCR, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
' Anything found?
If Not rngFoundFirst Is Nothing Then
    Call ProcessDcr(rngFoundFirst)

    Dim rngFoundNext As Range
    Set rngFoundNext = rngFoundFirst

    Do
        Set rngFoundNext = rngSearch.FindNext(rngFoundNext)

        ' If first one is found, stop looping.
        If Not rngFoundNext Is Nothing Then
            If rngFoundNext.Address = rngFoundFirst.Address Then
                Exit Do
            End If

            Call ProcessDcr(rngFoundNext)
        End If
    Loop Until rngFoundNext Is Nothing
End If

Set rngFoundNext = Nothing
Set rngFoundFirst = Nothing
Set rngSearch = Nothing

End Sub

Sub ProcessDcr(rngFound As Range)

Call rngFound.Offset(1, 3).Copy
Call Range("N11").PasteSpecial(Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False)

End Sub
于 2013-07-19T15:48:30.470 回答