堆叠相同数量的重复+非重复的单元格

我不知道如何用文字expression，所以也许视觉效果更好。 有人可以帮助我以下面的方式堆叠吗？ 各国按字母顺序排列。 到目前为止，我已经成功地堆叠独特或重复，但我不能堆叠我真正想要的方式。 也许我最好的描述是将最大数量的状态放在两列中，但是我不知道如何将它们与各个城市配对。

Sheet1 State City FL TPA FL FTL MO STL NV RNO TX HSTN TX AUS Sheet2 State City FL TPA FL FTL MO STL MO KSC MO HNB NY NY TX AMR TX NWT Sheet3 State City FL TPA FL FTL MO STL MO KSC MO HNB NV RNO NY NY TX HST TX AUS TX AMR TX NWT 

Answer 1

这一个需要大量使用Dictionary 。 基本上你需要一个国家，每个国家需要一个自己的城市字典。 试试这个代码，它会在你的例子中产生完全相同的Sheet3输出：

 Sub MergeStatesAndCities() Dim r As Range, dicStates As Object, sh As Worksheet Set dicStates = CreateObject("Scripting.Dictionary") For Each sh In ThisWorkbook.Worksheets For Each r In sh.Range("A2", sh.Range("A999999").End(xlUp)) 'set a dictionary of cities for each state! If Not dicStates.Exists(r.Text) Then Set dicStates(r.Text) = CreateObject("Scripting.Dictionary") dicStates(r.Text)(r.Offset(, 1).Text) = 0 ' add key for the city if not already there Next Next ' Now bring the values into new sheet Set sh = Sheets.Add sh.name = "AllStatesAndCities" sh.Range("A1:B1").Value = Array("State", "City") Dim state For Each state In dicStates.keys With sh.Range("A999999").End(xlUp).Offset(1).Resize(dicStates(state).Count) .Value = state .Offset(, 1).Value = Application.Transpose(dicStates(state).keys) End With Next ' Now Sort the result by states sh.UsedRange.Columns("A:B").Sort key1:=sh.Range("A2"), Header:=xlYes End Sub 

Answer 2

听起来就像你可以复制两张纸，删除重复和sorting：

 Sheet1.Cells.Copy Sheet3.Cells Sheet2.UsedRange.Copy Sheet3.Cells.End(xlDown)(2) Sheet3.Cells.RemoveDuplicates Array(1, 2) Sheet3.Cells.Sort Sheet3.Columns(1), , Sheet3.Columns(2), , , , , xlYes