Do bis IsEmpty funktioniert nicht, irgendwelche Ideen?

Question

Ich mache eine einfache Subtraktion zwischen zwei Zellen, die Daten enthalten, um den Zeitraum zu erhalten. Jedem Client, in Data_p Arbeitsblatt, Bereich ("4"), werden alle Bestelldaten in der jeweiligen Spalte angezeigt. Also wird die Subtraktion zwischen dem zweiten Datum und dem ersten usw. liegen und das Ergebnis wird in Data_p_mgnt eingefügt. Diese Funktion muss ausgeführt werden, bis für jeden Client keine Daten mehr vorhanden sind.

Ich habe den folgenden Code, aber ich weiß nicht, warum es nicht aufhören wird, wenn es findet und leere Zelle in Data_p. Jeder Einblick wird geschätzt.

Sub Prueba_Data_p_mgnt() 

Sheets("Data_p_mgnt").Select 
Range("B5").Select 'Starts in cell B5 

Do Until IsEmpty(Worksheets("Data_p").Range("B5")) 'Checks if cells in Data_p are Empty or Blank 

ActiveCell.FormulaR1C1 = "=Data_p!R[1]C-Data_p!RC" 'Makes the subtraction between cells 
ActiveCell.Offset(1, 0).Range("A1").Select 'Moves down for paste the next period 

Loop 'Loop until there's an Empty cell in Data_p 

'Then should move to next client to the right and repeat until there are no more clients in row 4 

End Sub 

Answer 1

Ich glaube, das ist, was Sie zu tun versuchen:

Sub Prueba_Data_p_mgnt() 
    Dim wsMgnt As Worksheet 
    Dim wsData As Worksheet 
    Dim rowNo As Long 
    Dim colNo As Long 
    Set wsMgnt = Worksheets("Data_p_mgnt") 
    Set wsData = Worksheets("Data_p") 

    colNo = 2 
    Do Until IsEmpty(wsData.Cells(4, colNo)) 'Checks if cells in Data_p are Empty or Blank 

     rowNo = 5 
     Do Until IsEmpty(wsData.Cells(rowNo, colNo)) 'Checks if cells in Data_p are Empty or Blank 
     'Alternatively, to avoid subtracting the last non-blank cell from a blank cell 
     'Do Until IsEmpty(wsData.Cells(rowNo + 1, colNo)) 'Checks if cells in Data_p are Empty or Blank 

      wsMgnt.Cells(rowNo, colNo).FormulaR1C1 = "=Data_p!R[1]C-Data_p!RC" 'Makes the subtraction between cells 
      'Alternatively, if you would rather have values than formulae 
      'wsMgnt.Cells(rowNo, colNo).Value = wsData.Cells(rowNo + 1, colNo).Value - wsData.Cells(rowNo, colNo).Value 

      rowNo = rowNo + 1 'Moves down for paste the next period 
     Loop 'Loop until there's an Empty cell in Data_p 

     colNo = colNo + 1 'Then should move to next client to the right and repeat until there are no more clients in row 4 
    Loop 

End Sub 

Answer 2

Dies sollte, hoffe ich, den Trick:

Sub Prueba_Data_p_mgnt() 
Dim dataWS As Worksheet 
Dim rng As Range 
Set dataWS = Sheets("Data_p_mgnt") 

Set rng = dataWS.Range("B5") ' what's this? You never use data_p_mgnt cell B5? 

For i = 5 To 100 ' Change 100 to whatever you need 
    If Not IsEmpty(Worksheets("Data_p").Range("b" & i)) Then 'Checks if cells in Data_p are Empty or Blank 
     Worksheets("Data_p").Range("b" & i).FormulaR1C1 = "=Data_p!R[1]C-Data_p!RC" 'Makes the subtraction between cells 
    End If 'Loop until there's an Empty cell in Data_p 
Next i 
End Sub 

Aber bei Ihrem Code suchen, ich weiß nicht, was Sie vorhaben, mit B5 auf dem Data_p_mgnt Blatt auf tun.