时间戳

首页 > 解决方案 > 循环比较列中的值，如果不同则插入新行，但如果第一行是唯一值则忽略第一行

excel - 循环比较列中的值，如果不同则插入新行，但如果第一行是唯一值则忽略第一行

问题描述

我正在对库存页面进行排序，并在排序后分离尺寸以使其更易于阅读。

如果顶行具有唯一值（该项目只有一行），则它不会在其后插入一行，而是将其与下一组值分组。

如果有超过 1 行具有该最高值，则它会在该组之后正确插入一行。

Private Sub CommandButton1_Click()

' sort by size then length
With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Selection.Columns(3), Order:=xlDescending
    .SortFields.Add Key:=Selection.Columns(4), Order:=xlDescending
    .SetRange Selection
    .Apply
End With


' insert rows between sizes
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("D9")

iRow = oRng.Row
iCol = oRng.Column

Do
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
   Cells(iRow + 1, iCol).EntireRow.Insert shift = xlDown
   iRow = iRow + 2
Else
   iRow = iRow + 1
End If

Loop While Not Cells(iRow, iCol).Text = ""

End Sub

它最终看起来像这样：https ://i.imgur.com/AfYXbuF.png

如何让它在该最高值之后插入一行？

标签： excelvbaexcel-2010

解决方案

我会稍微简化一下方法。

Private Sub CommandButton1_Click()

Dim iRow As Long
Dim oRng As Range

Set oRng = Range("D9", Range("D" & Rows.Count).End(xlUp))

For iRow = oRng.Count To 2 Step -1
    If oRng.Cells(iRow) <> oRng.Cells(iRow - 1) Then
        oRng.Cells(iRow).EntireRow.Insert shift:=xlDown
    End If
Next iRow

End Sub

推荐阅读