Mengolah Metadata dengan VBA - habibmarzuqi/Atom GitHub Wiki

1. Jika tabel berbentuk seperti

image

2. Pertama insert baris jika berkas berbeda dengan sebelumnya

Sub AddRowsForNonMatchingCellsInColumnC() Dim ws As Worksheet Set ws = ActiveSheet

Dim i As Long
' Mulai dari baris terakhir di kolom C dan bergerak ke atas
For i = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row To 2 Step -1
    ' Periksa jika nilai sel di kolom C tidak sama dengan sel di atasnya
    If ws.Cells(i, 3).Value <> ws.Cells(i - 1, 3).Value Then
        ' Menambahkan baris baru di bawah baris saat ini
        ws.Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
Next i

End Sub

3. lalu isi kolom yg td baru diisi dengan berkas yg sesuai

Sub FillEmptyInColumnDFromColumnC() Dim ws As Worksheet Set ws = ActiveSheet

Dim i As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row ' Dapatkan baris terakhir dengan data di kolom D

' Mulai loop dari baris pertama hingga baris terakhir di kolom D
For i = 1 To lastRow
    ' Periksa jika sel di kolom D kosong
    If IsEmpty(ws.Cells(i, "D")) Then
        ' Isi sel di kolom D dengan nilai dari kolom C di baris yang sama
        ws.Cells(i, "D").Value = ws.Cells(i + 1, "C").Value
    End If
Next i

End Sub

4. Menambahkan / Insert Row Level Item sesuai dengan jumlah image

Dengan kondisi buat tabel di sheet2 yang berisi nomor dan jumlah image

<style> </style>
nomor jumlah
2000 73
2001 239
2002 87
2003 348
2004 78
2005 152

Sub InsertRowsBasedOnCondition() Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRowSheet2 As Long, i As Long Dim searchValue As String, insertRows As Long Dim foundCell As Range

' Define worksheets
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

' Start from last row in Sheet2 to avoid overlap issues
lastRowSheet2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row

' Loop through Sheet2 from bottom to top
For i = lastRowSheet2 To 1 Step -1
    searchValue = ws2.Cells(i, "B").Value
    insertRows = ws2.Cells(i, "C").Value
    
    ' Skip if searchValue is empty or insertRows is not a number
    If searchValue = "" Or Not IsNumeric(insertRows) Then
        GoTo NextIteration
    End If
    
    ' Find searchValue in Sheet1 Column A
    Set foundCell = ws1.Columns("A:A").Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundCell Is Nothing Then
        ' Insert rows below the found cell
        foundCell.Offset(1, 0).Resize(insertRows).EntireRow.Insert Shift:=xlDown
    End If

NextIteration: Next i

MsgBox "Proses selesai!"

End Sub

⚠️ **GitHub.com Fallback** ⚠️