Question

A      B

1.     count
2.     _
3.     Count
4.     _
5.     _
6.     Labels
7.     2
8.     3
9.     5
10.    6
11.    shorttest
12.    midtest
13.    longtest
14.    coldtest
15.    hottest
16.    Resultant

我曾尝试写出代码，但我不确定它是否可行。

我现在想做的是，我想将A11复制到G16到另一张工作表，它们可以被视为测试周界。

但是有些时候会丢失一些参数，例如longtest和coldtest缺失，因为测试没有完成。如下所示

A      B

1.     count
2.     _
3.     Count
4.     _
5.     _
6.     Labels
7.     2
8.     3
9.     5
10.    6
10.    shorttest
11.    midtest
12.    hotest
13.    Resultant

还可以有测试参数，如night_test，morning_test等......

请注意，这些读数是从完成的测试中获得的，并手动添加到页面中。而且“结果”也将始终排在最后一行。

我想知道VBA是否可以处理第n个“A_”值（即A1，A2，A3 ...... An），而不仅仅是A11，如我的代码所示？并且它可以复制测试参数（对于这个例子，最短的结果）

我的代码如下：

Sub macro1()
    Dim valuecell As Range
    Dim irow As Range
    Dim iCol As Range

    For irow = 1 To 6
        For iCol = 1 To 1
            If valuecell = "1" Or _
              valuecell = "2" Or _
              valuecell = "3" Or _
              valuecell = "4" Or _
              valuecell = "5" Or _
              valuecell = "6" Then
                irow = irow + 1
            ElseIf valuecell = "Resultant" Then
                Range("A11:G13").Copy Destination:=Worksheets("sheet4").Range("A11")
            Else
                irow = irow + 1
            End If
        Next
    Next
End Sub

Answer 1

你的问题还不清楚，但如果我理解正确，你想要将数字1到6之后的所有内容复制到“结果”，到另一张表。以下代码将执行此操作。

Sub macro1()
    Dim valuecell As Range
    Dim irow As Long
    Dim iFirstRowToCopy As Long
    Dim iLastRowToCopy As Long
    Dim vValuesToCopy As Variant

    irow = 1 ' Initialise

    'Loop until you meet numbers between 1 and 6
    Do
        Set valuecell = Sheet1.Cells(irow, 1)
        If valuecell >= 1 And valuecell <= 6 Then
            Exit Do
        End If
        irow = irow + 1
    Loop

    'Loop until you get out of numbers between 1 and 6
    Do
        Set valuecell = Sheet1.Cells(irow, 1)
        If valuecell >= 1 And valuecell <= 6 Then
            'Do nothing
        Else
            iFirstRowToCopy = irow ' Found the first row to copy
            Exit Do
        End If
        irow = irow + 1
    Loop

    'Loop until you meet "Resultant"
    Do
        Set valuecell = Sheet1.Cells(irow, 1)
        If valuecell = "Resultant" Then
            iLastRowToCopy = irow ' Found the last row to copy
            Exit Do
        End If
        irow = irow + 1
    Loop

    'Read the values that need copying
    vValuesToCopy = Sheet1.Cells(iFirstRowToCopy, 1) _
        .Resize(iLastRowToCopy - iFirstRowToCopy + 1, 1)
    'Write the values to the destination sheet
    Worksheets("Sheet4").Cells(iFirstRowToCopy, 1) _
        .Resize(iLastRowToCopy - iFirstRowToCopy + 1, 1) = vValuesToCopy
End Sub

VBA可以预测第n行并复制参数吗？

1 个答案: