Bir sütunda boş bir hücre bulmak için, ardından boş hücrenin üstündeki hücreyi boş hücreye kopyalayın.

Question

10,000'in üzerinde satır içeren Excel'de bir SAP raporum var. 2 sütun vardır - A & B. A, $ değeridir ve B değeri için ref değeridir. SAP raporu, alt toplamları referans türüne göre gösterir, ancak alt toplam ref hücresi B her zaman boştur. Boş hücrenin üstündeki hücreyi boş hücreye (alt toplamla aynı satıra) kopyalamam gerekir. Örneğin. A1: A5, 3,2,3,1,1 değerine sahiptir, bu nedenle toplam toplam 10 ve A6'dadır. B6'daki hücre boş. B5'teki ref tipi 12kg'lık bir torbadır. Bu referansı B6 hücresine kopyalamam gerekiyor. Bunu yapmamın nedeni, raporu başka bir dosyaya kopyalamak için alt toplama göre filtrelemek. Şu anda bunu el ile yapıyorum ve yaşları alır. Sanırım raporu her çalıştırdığımda satırlar değiştikçe son satır kadar bir döngü kodu var. Teşekkür ederim!

Answer 1

Bu, aradığınız şey mi? Bu alt, tüm satırlar üzerinde döngü yapar ve B sütunundaki hücrenin boş olup olmadığını kontrol eder, ancak A sütunundaki hücre bir değer içerir. Eğer öyleyse, B hücresindeki hücreyi önceki satırdan geçerli satıra kopyalar.

Sub fillEmptyCells() 
'copies the above cell for each empty cell in B where the cell in A is not empty 
    Dim i As Integer 
    Dim lastRow As Integer 
    Dim ws As Worksheet 
    Set ws = ActiveSheet 

    lastRow = ws.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 'This gives the last Row with a nonempty cell in column A 
    For i = 1 To lastRow 
     If IsEmpty(ws.Cells(i, 2)) And Not IsEmpty(ws.Cells(i, 1)) Then 
      ws.Cells(i - 1, 2).Copy ws.Cells(i, 2) 
     End If 
    Next i 
End Sub 

Düzenleme: Burada with çevre

Sub fillEmptycells() 
'copies the above cell for each empty cell in B where the cell in A is not empty 
    Dim i As Integer 
    Dim lastRow As Integer 

    With ActiveSheet 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'This gives the last Row with a nonempty cell in column B 
     For i = 1 To lastRow 
      If IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 1)) Then 
       .Cells(i - 1, 2).Copy .Cells(i, 2) 
      End If 
     Next i 
    End With 
End Sub