Question

我的代码在一张母版纸上遍历数据行，并根据每一行上的数据类别更新不同的纸页。运行宏时，我可以看到信息暂时闪烁，然后消失。如果以前我使用相同的复制/粘贴命令，则不会发生这种情况。

使用WOB和ROP开头的两个循环将正确粘贴，而自定义循环则不会正确粘贴。我也尝试过将Select Case变成几个具有相同无效结果的elseif语句。

    Sub SortData()

Dim Datasheet As Worksheet
Dim ROPsheet As Worksheet 'Rate of Penetration
Dim Customsheet As Worksheet
Dim WOBsheet As Worksheet 'Weight on Bit

Dim i As Long 'Used as counter to loop through compiled data sheet
Dim j As Long 'Used as counter for each Limiter tested
Dim LastRowCount As Long 'Finds number of rows for ending loop

Dim Limiter As String 'These are WOB, ROP, Custom ect.
Dim DepthCheck As Double 'Checks depth on individual limiter sheet with depth on data sheet
Dim DatetCheck As String 'Checks date on individual limiter sheet with depth on data sheet
Dim Depth As Double 'depth from data sheet
Dim Datet As String 'date from limiter sheet

Dim y As Double 'Used to progress through rows

Set Datasheet = Worksheets("Data")
Set ROPsheet = Worksheets("ROP")
Set Customsheet = Worksheets("Custom")
Set WOBsheet = Worksheets("WOB")

y = 1
i = 1

'_____________________________________Working_Code_Below__________________________________________________________



'Arbitrary Count for testing
For i = 1 To 100

 y = y + 1

 Limiter = Worksheets("Data").Cells(y, 2).Value
 Depth = Worksheets("Data").Cells(y, 5).Value
 Datet = Worksheets("Data").Cells(y, 6).Value

'WOB
    If Limiter = "WOB" Then
      j = 1
      LastRowCount = WOBsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count

        For j = 1 To LastRowCount
         DepthCheck = Worksheets("WOB").Cells(j + 1, 5).Value
         DatetCheck = Worksheets("WOB").Cells(j + 1, 6).Value

            If DepthCheck <> Depth Or DatetCheck <> Datet Then
                 If j = LastRowCount Then
                         Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("WOB").Cells(j + 1, 2)
                        GoTo EndLast
                 End If

            Else
                GoTo EndLast

            End If

        Next j

    Else
        GoTo ROPStart

    End If

ROPStart:


    If Limiter = "ROP" Then
      j = 1
      LastRowCount = ROPsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count

        For j = 1 To LastRowCount
         DepthCheck = Worksheets("ROP").Cells(j + 1, 5).Value
         DatetCheck = Worksheets("ROP").Cells(j + 1, 6).Value

            If DepthCheck <> Depth Or DatetCheck <> Datet Then
                 If j = LastRowCount Then
                         Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("ROP").Cells(j + 1, 2)
                        GoTo EndLast
                 End If

            Else
                GoTo EndLast

            End If

        Next j

    Else
        GoTo CustomStart

    End If

CustomStart:

    j = 1
    LastRowCount = Customsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count

    Select Case Limiter

    Case "WOB", "Balling", "RPM", "Vibrations", "Torque", "Buckling", "Differential Pressure", "Flow Rate", "Pump Pressure", "Well Control", "Directional", "Logging", "ROP"
        GoTo EndLast

    Case Else
        For j = 1 To LastRowCount
            DepthCheck = Worksheets("Custom").Cells(j + 1, D).Value
            DatetCheck = Worksheets("Custom").Cells(j + 1, dt).Value

            If DepthCheck <> Depth Or DatetCheck <> Datet Then

                If j = LastRowCount Then
                    Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("Custom").Cells(j + 1, 2)
                    GoTo EndLast
                End If

            Else
                GoTo EndLast

            End If

       Next j

   End Select

EndLast:

Next i
End Sub

没有错误消息出现。

PS。这是我的第一篇文章，对不起，如果格式很奇怪。

Answer 1

欢迎来到SO，并祝贺您发表第一篇文章。这些日子之一，我将与您同在，我只是在寻找一个完美的问题。缺乏勇气与童军的荣誉无关。小指承诺！

由于非线性流程，我尝试遵循您的代码并为此付出了很多努力。您描述的问题听起来像是先写入数据，然后覆盖数据。这通常是由多余的循环引起的，在您的情况下，可能是由GoTo引起的。

触摸有关查找行数的注释；这是一个令人惊讶的细微差别的主题，有许多不同的答案，而正确的答案取决于您的情况和需求。大多数时候，我可以使用UsedRange，就像Sheet1.UsedRange.Rows.Count一样；但是我主要从事电子表格的维护和工作，这些工作要保持我当时所知所能。我不记得多久之前我将此网站加为书签，但是我发誓我每天连续几个月使用它：OZGrid Excel Ranges当然，Chip Pearson值得一访CPearson Last Used Cell

请把这最后一点作为建设性批评，并大声笑。当您尝试遵循此代码而迷路时，请退后一步，查看您的代码，找到相同的模式-并停止这样做。打破习惯，努力打破习惯。尝试调试意大利面代码时，包括我在内的某些人几乎会发自内心的反应。尝试从上到下线性书写。您会发现您对自己的代码有更好的了解，更容易跟踪自己的想法并将这些想法转换为代码。这是一个双赢的局面。 GoTo几乎完全没有必要，并且确实阻碍了其他人寻求帮助的进程。在这里使用一个或5行功能中可能会有一些方便的快捷方式，但是最好避免在代码需要滚动时使用。

Sub aProcedure()
    GoTo T
V:
    j = vbCancel
    b = "point"
    GoTo K
X2:
    j = x
    b = "before"
    GoTo K
A1:
    For i = VbMethod To vbCancel
        b = DoThingWith(DoThingWith(b, 44), b)
    Next
    j = j * 3
    a = DoThingWith(a, b)
    GoTo Z
Z:
    b = "times"
    GoTo K
U2:
    j = j + 1 - x
    b = "has"
    GoTo K
A2:
    MsgBox DoThingWith(a)
    Exit Sub
X1:
    j = j + 1
    b = "made"
    GoTo K
T:
    a = "this"
    GoTo U1
K:
    a = DoThingWith(a, b)
DoEvents
    Select Case j
        Case 0
            GoTo A2
        Case 1
            GoTo U1
        Case 2
            GoTo U2
        Case 3
            GoTo W
        Case 4
            GoTo X1
        Case 5
            GoTo Y
        Case Else
            GoTo X2
    End Select
W:
    j = 2 * (j - 1)
    b = "been"
    GoTo K
Y:
    b = "many"
    GoTo A1
U1:
    a = Replace(a, Left(a, 1), UCase(Left(a, 1)))
    GoTo V
End Sub

Private Function DoThingWith(a, Optional b = 46, Optional c = 32)
    If IsNumeric(b) Then
        b = CInt(b)
        c = CInt(c)
        Select Case Asc(Right(a, 1))
            Case b
                DoThingWith = a & Chr(b - c - 1)
            Case Else
                DoThingWith = a & Chr(b)
        End Select
    ElseIf IsNumeric(c) Then
        c = CInt(c)
        DoThingWith = a & Chr(c) & b
    Else
        DoThingWith = a & b & c
    End If
End Function

输出：

仅可临时复制/粘贴的VBA代码

1 个答案: