Question

我尝试构建一个循环，在满足条件时回收某些数据，然后将结果发布到我的主要数据中。片。

不幸的是，当您运行宏时，它不会撤回所有数据。

然而，在我看来这是非常奇怪的，当你逐步完成它。

代码中的任何一点都没有错误消息，如果您单步执行/只运行宏，代码将全程运行。

我在下面发布了我的代码：

Sub Loop_Data()
    'BR stands for Blank Row
    Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer, _
    SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range

    BRMAin = Sheets("Main").Cells(Rows.Count, "W").End(xlUp).Row
    BRData = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
    BRPhysNot = Sheets("PhysNot").Cells(Rows.Count, "A").End(xlUp).Row

    Set SearchRange = Sheets("Data").Range("A3:A" & BRData)
    Sheets("CoData").Activate
    'assign j for number of rows (units) and i to start at 6 (column J) and end at 21

    For j = 2 To 48
        i = 35
        Do Until i = 52
                'criteria 
            If Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And Cells(j, i - 1) > 0 And Cells(j, i).Interior.Color = RGB(51, 51, 51) Then
                'find duration o
                m = 0
                Do While Cells(j, i + m).Interior.Color = RGB(51, 51, 51)
                    m = m + 1
                Loop
                'check that the flagged is definitely matching criteria
                If Cells(j, i + m) = 0 Then
                    'set string ID as the string of uni & period to find in the helper column of Data sheet
                    'set k as row which that occurs in
                    strID = Cells(1, i) & Cells(j, 3)
                    Set FindRow = SearchRange.Find(strID)
                    k = FindRow.Row
                    'Pull back data into main sheet
                    ThisWorkbook.Sheets("Main").Range("X" & BRMAin + 1) = Sheets("Data").Cells(k, 8)
                    ThisWorkbook.Sheets("Main").Range("V" & BRMAin + 1) = Sheets("Data").Cells(k, 4)
                    ThisWorkbook.Sheets("Main").Range("W" & BRMAin + 1) = Sheets("Data").Cells(k, 2)
                    ThisWorkbook.Sheets("Main").Range("Y" & BRMAin + 1) = m
                    ThisWorkbook.Sheets("Main").Range("Z" & BRMAin + 1) = Sheets("CoData").Cells(1, i)
                End If
            End If
            i = i + 1
        Loop
    Next j
End Sub

Answer 1

如果Wait或DoEvents不起作用，而不是使用

Set FindRow = SearchRange.Find(strID)
k = FindRow.Row

你可以选择

k = 0
For Each SearchCell In SearchRange
    If SearchCell.Text = strID Then k = SearchCell.Row
Next

Answer 2

我不是百分百肯定，但我怀疑这与你有多张床单有关，但你并不具体说明你的范围要求哪张纸。我会为每个范围和单元格添加调用工作表。请参阅下面的代码，如果有帮助请告诉我。

Sub Loop_Data() 'loops through CoData Sheet

'BR stands for Blank Row
Dim wb As Workbook, wsData As Worksheet, wsMain As Worksheet, wsPhys As Worksheet, wsCoData As Worksheet
Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer
Dim SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range

Set wb = ThisWorkbook
Set wsData = wb.Sheets("Data")
Set wsMain = wb.Sheets("Main")
Set wsPhys = wb.Sheets("PhysNot")
Set wsCoData = wb.Sheets("CoData")

BRMAin = wsMain.Cells(Rows.Count, "W").End(xlUp).Row
BRData = wsData.Cells(Rows.Count, "A").End(xlUp).Row
BRPhysNot = wsPhys.Cells(Rows.Count, "A").End(xlUp).Row

Set SearchRange = wsData.Range("A3:A" & BRData)
wsCoData.Activate 'Not necessary to activate a sheet if you need to pull data from it if you link a range to a specific sheet.
'assign j for number of rows (units) and i to start at 6 (column J) and end at 21
For j = 2 To 48

    i = 35
    Do Until i = 52
        'criteria
        If wsCoData.Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = RGB(51, 51, 51) Then

            'find duration o
            m = 0
            Do While wsCoData.Cells(j, i + m).Interior.Color = RGB(51, 51, 51)
                m = m + 1
            Loop

            'check that the flagged is definitely matching criteria
            If wsCoData.Cells(j, i + m) = 0 Then
                'set string ID as the string of uni & period to find in the helper column of Data sheet
                'set k as row which that occurs in
                strID = wsCoData.Cells(1, i) & wsCoData.Cells(j, 3)
                Set FindRow = SearchRange.Find(strID)
                k = FindRow.Row

                'Pull back data into main sheet
                wsMain.Range("X" & BRMAin + 1) = wsData.Cells(k, 8)
                wsMain.Range("V" & BRMAin + 1) = wsData.Cells(k, 4)
                wsMain.Range("W" & BRMAin + 1) = wsData.Cells(k, 2)
                wsMain.Range("Y" & BRMAin + 1) = m
                wsMain.Range("Z" & BRMAin + 1) = wsCoData.Cells(1, i)
            End If
        End If

        i = i + 1
    Loop
Next j

End Sub

我不得不猜测未标记的范围，我只是假设它们与CoData工作表有关，因为这是你最后一次活动的。

另外，如果它有帮助，我注意到你一直在呼唤一种特定的颜色，你也可以把它变成一个变量，所以你不要一直打字。见下文。

Dim grey as Long
grey = RGB(51, 51, 51)

'Colors are just stored as Longs, in some cases Integer will work, but its mostly safer to just always stick to Long. 
'So your grey would equal 3355443: 51 + 51*256 + 51 *256*256

'Example Uses...
If wsCoData.Cells(j, i - 1).Interior.Color <> grey And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = grey Then
    '...Your code
End if

Do While Cells(j, i + m).Interior.Color = grey
    m = m + 1
Loop

当我单步执行时，我的vba循环会撤回所有正确的数据，但是当我运行宏时它不会

2 个答案: