次の空白のセルから過去の値を検索する

Question

古いマクロを修復するために多くの時間を節約できるマクロを作成しようとしています。私がしようとしているのは、値が "MonoBi"から "Bi recurso"まで過去のものを見つけたい場合、 "MonoRisco 3"と "MonoBi"の値を比較することです。私は既に存在するリストの終わりにその値を過ぎたい。私はそれが可能だと思うが、私は方法を知らない。私はコードが最適化されていないが、私はそれが最初に実行し、それを修正したいと思います。事前に感謝

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

は、私はあなたが以下を使用してコードを置き換える場合は、（これは「モノリスコ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