Question

我正在尝试编写一个宏，可以节省我很多时间来修复旧的宏。我想要做的是比较一个位于“Mono risco 3”和“MonoBi”的值，如果它发现该值我想要从“MonoBi”到“Bi recurso”的某些值。我想在已经存在的列表的末尾过去那些值。我认为这是可能的，但我不知道如何。我知道代码没有优化但我希望它先运行然后纠正它。提前致谢

Do While Sheets("Bi recurso").Cells(lin_dest_1, 1) = ""

    Select Case True

    Case Sheets("Bi recurso").Cells(lin_dest_1, 1).Value2 = "":

    If Sheets("Mono risco 3").Cells(lin_ori_1, 1) <> "" Then

        Do While Sheets("Mono risco 3").Cells(lin_ori_1, 1) <> ""

            Do While Sheets("MonoBi").Cells(lin_ori_2, 1) <> ""

                Select Case True

                Case Sheets("Mono risco 3").Cells(lin_ori_1, 1) = Sheets("MonoBi").Cells(lin_ori_2, 1):


                    Sheets("Bi recurso").Cells(lin_dest_1, 1).Value2 = Sheets("MonoBi").Cells(lin_ori, 1).Value2
                    Sheets("Bi recurso").Cells(lin_dest_1, 2).Value2 = Sheets("MonoBi").Cells(lin_ori, 2).Value2
                    Sheets("Bi recurso").Cells(lin_dest_1, 3).Value2 = "Mono Bi"
                    Sheets("Bi recurso").Cells(lin_dest_1, 4).Value2 = Sheets("MonoBi").Cells(lin_ori, 4).Value2
                    Sheets("Bi recurso").Cells(lin_dest_1, 5).Value2 = Sheets("MonoBi").Cells(lin_ori, 5).Value2
                    Sheets("Bi recurso").Cells(lin_dest_1, 6).Value2 = Sheets("MonoBi").Cells(lin_ori, 6).Value2
                    Sheets("Bi recurso").Cells(lin_dest_1, 7).Value2 = Sheets("MonoBi").Cells(lin_ori, 7).Value2
                    lin_ori_1 = lin_ori_1 + 2

                Case Else


                    lin_ori_2 = lin_ori_2 + 1


                End Select
                Loop
                Loop

    Case Else: lin_dest_1 = lin_dest_1 + 1

    End Select


    '
    End Sub

Answer 1

我相信如果你用下面的代码替换你的代码，它应该按预期工作（假设“Mono risco 3”和“MonoBi”都有标题）：

Sub foo()
MonoRiscoLastRow = Sheets("Mono risco 3").Cells(Sheets("Mono risco 3").Rows.Count, "A").End(xlUp).Row 'get last row on column A of Sheet Mono risco 3
MonoBiLastRow = Sheets("MonoBi").Cells(Sheets("MonoBi").Rows.Count, "A").End(xlUp).Row 'get last row on column A of Sheet MonoBi

For i = 2 To MonoRiscoLastRow 'loop through Mono Risco
    For x = 2 To MonoBiLastRow 'loop through MonoBi
        If Sheets("Mono risco 3").Cells(i, 1).Value2 = Sheets("MonoBi").Cells(x, 1).Value2 Then 'do your comparison, if equal then
        BiRecursoNextRow = Sheets("Bi recurso").Cells(Sheets("Bi recurso").Rows.Count, "A").End(xlUp).Row + 1
        'get next empty row on column A of Sheet Bi Recurso
            For y = 1 To 7
                Sheets("Bi recurso").Cells(BiRecursoNextRow, y).Value2 = Sheets("MonoBi").Cells(x, y).Value2
            Next y
            Sheets("Bi recurso").Cells(BiRecursoNextRow, 3).Value2 = "Mono Bi"
    Next x
Next i
End Sub

Answer 2

这是你的建议之后的解决方案：

Option Explicit

Sub macro_monos_monobi()
'
' macro_monos_monobi Macro
'

Dim lin_ori_1 As Integer
Dim lin_ori_2 As Integer
Dim BirecursoNextRow As Integer

lin_ori_1 = 2
lin_ori_2 = 2


BirecursoNextRow = Sheets("Bi recurso").Cells(Sheets("Bi recurso").Rows.Count, "A").End(xlUp).Row + 1

If Sheets("Mono risco 3").Cells(lin_ori_1, 1) <> "" Then

    Do While Sheets("Mono risco 3").Cells(lin_ori_1, 1) <> ""

        Do While Sheets("MonoBi").Cells(lin_ori_2, 1) <> ""

            Select Case True

            Case Sheets("Mono risco 3").Cells(lin_ori_1, 1) = Sheets("MonoBi").Cells(lin_ori_2, 1):


                Sheets("Bi recurso").Cells(BirecursoNextRow, 1).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 1).Value2
                Sheets("Bi recurso").Cells(BirecursoNextRow, 2).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 2).Value2
                Sheets("Bi recurso").Cells(BirecursoNextRow, 3).Value2 = "Mono Bi"
                Sheets("Bi recurso").Cells(BirecursoNextRow, 4).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 4).Value2
                Sheets("Bi recurso").Cells(BirecursoNextRow, 5).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 5).Value2
                Sheets("Bi recurso").Cells(BirecursoNextRow, 6).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 6).Value2
                Sheets("Bi recurso").Cells(BirecursoNextRow, 7).Value2 = Sheets("MonoBi").Cells(lin_ori_2, 7).Value2
                lin_ori_1 = lin_ori_1 + 2
                BirecursoNextRow = BirecursoNextRow + 1

            Case Else:

                lin_ori_2 = lin_ori_2 + 1

            End Select

            Loop
                lin_ori_2 = 2
            Loop

End If


'
End Sub

找到过去值的下一个空白单元格

2 个答案: