Сравнить и вставить строку (VBA)

Question

Я стараюсь Ехчел к:

Сравнить столбцы G и H
- Если они имеют один и тот же текст -> перейти на следующую строку, чтобы продолжить сравнение
- Если у них нет одинакового текста -> Вставьте строку ниже G, а затем продолжите сравнение.

Результат будет следующим образом:

Перед запуском макро (первый столбец G, вторая колонка представляет собой Н):

После запуска макроса:

Можете ли вы мне помочь, пожалуйста?

Большое спасибо.

Answer 1

Что-то вроде этого

Sub CompArray() 
Dim G 
Dim H 
Dim X 
Dim lngCnt As Long 
Dim lngMark As Long 

G = Range([g1], Cells(Rows.Count, "G").End(xlUp)) 
H = Range([H1], Cells(Rows.Count, "H").End(xlUp)) 
X = H 

For lngCnt = 1 To UBound(X, 1) 
If G(lngCnt - lngMark, 1) = H(lngCnt, 1) Then 
X(lngCnt, 1) = G(lngCnt - lngMark, 1) 
Else 
lngMark = lngMark + 1 
X(lngCnt, 1) = vbNullString 
End If 
Next 

[g1].Resize(UBound(X), 1) = X 

End Sub 

Answer 2

Вы можете выбрать диапазон, который вы хотите посмотреть и затем цикл по строкам. Сравните ячейки, если они не совпадают, выберите правую ячейку. Затем вставьте новую ячейку и переместите все в 1 ячейку вниз Этот код немного медленный, потому что он выбирает весь столбец. Вы можете изменить операционную смету, чтобы сделать другой сравнения.

Dim rngCompare As Range 
Dim rowCount As Long 
Dim iCount As Long 

Set rngCompare = ActiveSheet.Columns("D:E") 
rowCount = rngCompare.Rows.Count 
For iCount = 1 To rowCount 
If StrComp(rngCompare.Cells(iCount, 1), rngCompare.Cells(iCount, 2), vbTextCompare) <> 0 Then 
    rngCompare.Cells(iCount, 1).Select 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 

End If 
Next iCount