如何对齐在同一行重复在Excel中VBA

我有这个文件：

1004 Dr Margarita Solorzano Olabarria SILVER 228230185  
    1004 Mr Jose Manuel Santos Aboim Inglez BRONZE 236338858  
    1007 Mrs Amanda De Souza Rodrigues  BRONZE 238246729  
    1007 Mr Eduardo Jaime Smejoff   BRONZE 214046768  
    1010 Mrs Genevieve Thie     PLATIN 221093078 
    1010 Mrs Mary Wilson      PLPLUS 21384102  
    1203 Ms Valerie Harrison     BRONZE 207754414  
    1203 Ms Joy Bridget Moncrieff   BRONZE 207754415

与在A柱：船舱总数

列B ：先生女士或者

柱C：一是&姓

上校UMN d：状态（铜，银等）

E列：会员编号

如果列A是一样的，我希望它在同一行。但它不包括状态青铜，白银，黄金，所以我把这个在我的VBA排除那些：

ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""GOLD""),""Delete"", """")"

当我运行宏，它gaves我：

1211 Mr Thomas Buettner PLPLUS Mr Heinz Juergen Nolte PLPLUS 
4011 Mr Michael Brent PLATIN Mrs Wilhelmina Johanna PLATIN 
4013 Mrs Nancy Jean  PLATIN Mr James    PLATIN 
4034 Mr Donald Meyer PLATIN Mrs Marcia Meyer  PLATIN 
1010 Mrs Genevieve Thie PLATIN 
1010 Mrs Mary Wilson PLPLUS

看数1010 ..

不知怎的，两者都是条件，但因为他们有不同的状态，宏将它们放在不同的行，我不希望这样，我希望他们在同一行..

你能帮助我..

新增年03月7日，这是我的整个宏（我不想要的另一个子）：

Sub LATDownloadMACROS() 
' 
' LATDownloadMACROS Macro 
' Macro recorded 02/25/2017 by Johan Esteve 


' Debut Macro 
Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers 
Cells.EntireColumn.AutoFit 
Columns("D:D").Insert Shift:=xlToRight 
Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
Columns("E:E").Insert Shift:=xlToRight 
Range("E2").FormulaR1C1 = "=PROPER(RC[-3])&"" ""&PROPER(RC[-1])&"" ""&PROPER(RC[-2])" 
Range("E2").AutoFill Destination:=Range("E2:E4200"), Type:=xlFillDefault 
Range("E2:E4200").Select 
Columns("E:E").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Columns("B:D").Select 
Range("D1").Activate 

Application.CutCopyMode = False 
Selection.Delete Shift:=xlToLeft 
Range("B18").Select 
Sheets("Sheet1").Select 
Sheets.Add 
Sheets("Sheet1").Select 
Sheets("Sheet1").Name = "Download" 
Sheets("Download").Select 
Cells.Select 
Selection.Copy 
Sheets("Sheet2").Select 
Cells.Select 
ActiveSheet.Paste 
Range("B1").Select 

Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "Guest 1" 
Range("C1").FormulaR1C1 = "Level1" 
Range("D1").FormulaR1C1 = "Guest 2" 
Range("E1").FormulaR1C1 = "Level2" 
Range("F1").FormulaR1C1 = "Guest 3" 
Range("G1").FormulaR1C1 = "Level3" 
Range("F1:G1").AutoFill Destination:=Range("F1:M1"), Type:=xlFillDefault 

Range("D1").FormulaR1C1 = "Guest 2" 
Range("D2").FormulaR1C1 = "=IF(RC[-3]=R[-1]C[-3],RC[-2],"""")" 
Range("E2").FormulaR1C1 = "=IF(RC[-4]=R[-1]C[-4],RC[-2],"""")" 
Range("D2").FormulaR1C1 = "=IF(R[1]C[-3]=RC[-3],R[1]C[-2],"""")" 
Range("E2").FormulaR1C1 = "=IF(R[1]C[-4]=RC[-4],R[1]C[-2],"""")" 
Range("F2").FormulaR1C1 = "=IF(R[2]C[-5]=RC[-5],R[2]C[-4],"""")" 
Range("G2").FormulaR1C1 = "=IF(R[2]C[-6]=RC[-6],R[2]C[-4],"""")" 
Range("H2").FormulaR1C1 = "=IF(R[3]C[-7]=RC[-7],R[3]C[-6],"""")" 
Range("I2").FormulaR1C1 = "=IF(R[3]C[-8]=RC[-8],R[3]C[-6],"""")" 
Range("J2").FormulaR1C1 = "=IF(R[4]C[-9]=RC[-9],R[4]C[-8],"""")" 
Range("K2").FormulaR1C1 = "=IF(R[4]C[-10]=RC[-10],R[4]C[-8],"""")" 
Range("L2").FormulaR1C1 = "=IF(R[5]C[-11]=RC[-11],R[5]C[-10],"""")" 
Range("M2").FormulaR1C1 = "=IF(R[5]C[-12]=RC[-12],R[5]C[-10],"""")" 
Range("D2:M2").AutoFill Destination:=Range("D2:M4200"), Type:=xlFillDefault 
Range("D2:M4200").Select 

Columns("D:M").AutoFit 
Sheets("Sheet2").Move Before:=Sheets(1) 

Sheets("Sheet2").Select 
Sheets("Sheet2").Copy Before:=Sheets(2) 
Sheets("Sheet2 (2)").Select 
Range("D2").Select 
Sheets("Sheet2").Select 
Columns("D:M").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Columns("A:A").Select 

Application.CutCopyMode = False 
Selection.Insert Shift:=xlToRight 
Range("A2").FormulaR1C1 = "=IF(RC[1]=R[-1]C[1],""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A6"), Type:=xlFillDefault 
Range("A2:A6").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Columns("A:A").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Cells.Select 

Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 

Sheets("Sheet2 (2)").Select 
Columns("A:C").Sort Key1:=Range("C2"), Order1:=xlDescending, Key2:=Range("A2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Columns("A:A").Insert Shift:=xlToRight 

Range("A2").FormulaR1C1 = "=if" 
Range("A2").FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""BRONZE"",RC[3]=""SILVER""),""Delete"","""")" 

Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 

Columns("A:A").Select 
Sheets("Sheet2 (2)").Select 
Sheets.Add 
Sheets("Sheet4").Select 
Sheets("Sheet4").Move After:=Sheets(3) 
Sheets("Sheet2").Select 
Sheets("Sheet2").Name = "Champagne" 
Sheets("Sheet2 (2)").Select 
Sheets("Sheet2 (2)").Name = "Water" 
Columns("E:N").Copy 

Sheets("Sheet4").Select 
Range("D1").Select 
ActiveSheet.Paste 
Range("D2").Select 
Sheets("Water").Select 
Cells.Select 
Application.CutCopyMode = False 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Sheets("Download").Select 
Selection.Copy 
Columns("A:C").Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("Sheet4").Select 
Columns("A:C").Select 
ActiveSheet.Paste 

' Ambassador 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Key2:=Range("A2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Columns("A:A").Insert Shift:=xlToRight 
Range("A1").FormulaR1C1 = "" 
Range("A2").Select 
Sheets("Sheet4").Select 
Sheets("Sheet4").Copy Before:=Sheets(3) 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Move After:=Sheets(4) 
Sheets("Sheet4").Select 
Sheets("Sheet4").Name = "Ambassador" 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""GOLD"",RC[3]=""PLATIN"",RC[3]=""PLPLUS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Sheets("Ambassador").Select 
Rows("2:4200").Select 
Range(Selection, Selection.End(xlDown)).Select 
ActiveWorkbook.Worksheets("Ambassador").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Ambassador").Sort.SortFields.Add Key:=Range(_ 
    "A2:A4200"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
ActiveWorkbook.Worksheets("Ambassador").Sort.SortFields.Add Key:=Range(_ 
    "B2:B4200"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortTextAsNumbers 
With ActiveWorkbook.Worksheets("Ambassador").Sort 
    .SetRange Range("A2:O4200") 
    .Header = xlGuess 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Rows("1:1").Select 

' Chocolate 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Key2:=Range("C2"), Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers 
Columns("A:A").Insert Shift:=xlToRight 
Range("A1").FormulaR1C1 = "" 
Range("A2").Select 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Copy Before:=Sheets(3) 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Move After:=Sheets(4) 
Sheets("Sheet4 (3)").Select 
Sheets("Sheet4 (3)").Name = "ChocoStrawb" 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""GOLD""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Sheets("ChocoStrawb").Select 
Rows("2:4200").Select 
Range(Selection, Selection.End(xlDown)).Select 
ActiveWorkbook.Worksheets("ChocoStrawb").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("ChocoStrawb").Sort.SortFields.Add Key:=Range(_ 
    "A2:A4200"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
ActiveWorkbook.Worksheets("ChocoStrawb").Sort.SortFields.Add Key:=Range(_ 
    "B2:B4200"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortTextAsNumbers 
With ActiveWorkbook.Worksheets("ChocoStrawb").Sort 
    .SetRange Range("A2:O4200") 
    .Header = xlGuess 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Rows("1:1").Select 

' PlatinumPlus 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("D2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortTextAsNumbers 
Columns("A:A").Insert Shift:=xlToRight 
Range("A1").FormulaR1C1 = "" 
Range("A2").Select 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Copy Before:=Sheets(3) 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Move After:=Sheets(4) 
Sheets("Sheet4 (3)").Select 
Sheets("Sheet4 (3)").Name = "PlatPlus" 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""GOLD"",RC[3]=""PLATIN"",RC[3]=""AMBASS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

' Platinum 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("D2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortTextAsNumbers 
Columns("A:A").Insert Shift:=xlToRight 
Range("A1").FormulaR1C1 = "" 
Range("A2").Select 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Copy Before:=Sheets(3) 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Move After:=Sheets(4) 
Sheets("Sheet4 (3)").Select 
Sheets("Sheet4 (3)").Name = "Platinum" 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""GOLD"",RC[3]=""PLPLUS"",RC[3]=""AMBASS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

' Gold 
Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortTextAsNumbers 
Range("C6").Select 
Range("C496:C4288").Select 
Range("C4288:C16").Select 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Copy Before:=Sheets(5) 
Sheets("Sheet4 (2)").Select 
Sheets("Sheet4 (2)").Name = "Gold" 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""BRONZE"", RC[3]=""PLATIN"",RC[3]=""PLPLUS"",RC[3]=""AMBASS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
' Rajout 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

' Silver 

Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Cells.Select 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Range("C13").Select 
Sheets("Platinum").Select 
Cells.Select 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Range("C7").Select 
Sheets("Gold").Select 
Sheets("Sheet4 (3)").Select 
Sheets("Sheet4 (3)").Name = "Silver" 
Sheets("Silver").Select 
Sheets("Silver").Copy Before:=Sheets(6) 
Sheets("Silver").Select 
ActiveCell.FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""PLATIN"", RC[3]=""BRONZE"", RC[3]=""GOLD"",RC[3]=""PLPLUS"",RC[3]=""AMBASS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 

Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Cells.Select 

' Bronze 

Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Cells.Select 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 
Sheets("Silver (2)").Select 
Columns("B:D").Select 
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 
Range("A2").FormulaR1C1 = "=IF(OR(RC[1]=R[-1]C[1],RC[3]=""SILVER"", RC[3]=""PLATIN"", RC[3]=""GOLD"",RC[3]=""PLPLUS"",RC[3]=""AMBASS""),""Delete"", """")" 
Range("A2").AutoFill Destination:=Range("A2:A519"), Type:=xlFillDefault 
Range("A2:A519").AutoFill Destination:=Range("A2:A4200"), Type:=xlFillDefault 
Range("A2:A4200").Select 
Cells.Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Cells.Select 

Application.CutCopyMode = False 
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _ 
    , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers 

' Nomage C1 
Sheets("Champagne").Select 
Range("C1").Select 
Selection.Copy 
Sheets("Ambassador").Select 
Range("C1").Select 
ActiveSheet.Paste 
Sheets("PlatPlus").Select 
Range("D1").Select 
ActiveSheet.Paste 
Sheets("ChocoStrawb").Select 
Range("D1").Select 
ActiveSheet.Paste 
Sheets("Ambassador").Select 
Range("D1").Select 
ActiveSheet.Paste 
Sheets("Platinum").Select 
Range("C1").Select 
ActiveSheet.Paste 
Sheets("Gold").Select 
Range("C1").Select 
ActiveSheet.Paste 
Sheets("Silver").Select 
Range("C1").Select 
ActiveSheet.Paste 
Sheets("Silver (2)").Select 
Range("C1").Select 
ActiveSheet.Paste 

' Nomage Bronze 
Sheets("Silver (2)").Select 
Sheets("Silver (2)").Name = "Bronze" 
Range("A1").Select 

Sheets("Champagne").Select 
Range("A1").Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "" 
Range("A1").Select 

' Filtre et Figer 
Sheets("Champagne").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Platinum").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("PlatPlus").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Columns("A:A").Select 
Selection.Delete Shift:=xlToLeft 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Silver").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Bronze").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Gold").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("ChocoStrawb").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Columns("A:A").Select 
Selection.Delete Shift:=xlToLeft 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Water").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Ambassador").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Columns("A:A").Select 
Selection.Delete Shift:=xlToLeft 
Range("C2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 
Sheets("Download").Select 
Cells.Select 
Cells.EntireColumn.AutoFit 
Range("A2").Select 
ActiveWindow.FreezePanes = True 
Rows("1:1").Select 
Selection.AutoFilter 

' Color 
Sheets("Champagne").Select 
ActiveWorkbook.Sheets("Champagne").Tab.ColorIndex = 6 
Sheets("Platinum").Select 
ActiveWorkbook.Sheets("Platinum").Tab.ColorIndex = 16 
Sheets("PlatPlus").Select 
ActiveWorkbook.Sheets("PlatPlus").Tab.ColorIndex = 55 
Sheets("Silver").Select 
ActiveWorkbook.Sheets("Silver").Tab.ColorIndex = 15 
Sheets("Bronze").Select 
ActiveWorkbook.Sheets("Bronze").Tab.ColorIndex = 9 
Sheets("Gold").Select 
ActiveWorkbook.Sheets("Gold").Tab.ColorIndex = 43 
Sheets("ChocoStrawb").Select 
ActiveWorkbook.Sheets("ChocoStrawb").Tab.ColorIndex = 3 
Sheets("Water").Select 
ActiveWorkbook.Sheets("Water").Tab.ColorIndex = 2 
Sheets("Ambassador").Select 
ActiveWorkbook.Sheets("Ambassador").Tab.ColorIndex = 1 
Sheets("Download").Select 
ActiveWorkbook.Sheets("Download").Tab.ColorIndex = 4 

' Delete 

Dim WS As Worksheet 

For Each WS In ActiveWorkbook.Worksheets 
For x = 4200 To 2 Step -1 
    If WS.Cells(x, 1).Value = "Delete" Then 
     WS.Rows(x).EntireRow.Delete 
    End If 
Next x 
Next WS 


' Formulas 

Sheets("Water").Select 
Cells.Select 
Range("A2").Select 
ActiveCell.Formula = "=SUM(D2:N2)+((COUNTIF(D2:N2,""GOLD"")+COUNTIF(D2:N2,""PLATIN""))*1)+((COUNTIF(D2:N2,""PLPLUS"")+COUNTIF(D2:N2,""AMBASS""))*2)" 
Range("A2").AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row) 
LastRow = Range("A2").End(xlDown).Row 
Cells(LastRow + 2, "A").Formula = "=SUM(A2:A" & LastRow & ")" 
Dim LRowA As String, LRowB As String 
LRowA = [A4200].End(xlUp).Address 
Range("A:A").Interior.ColorIndex = xlNone 
Range("A2:" & LRowA).Interior.ColorIndex = 33 
Range("A:A").HorizontalAlignment = xlCenter 



' Classement Onglets 
Sheets("Water").Select 
Sheets("Water").Move Before:=Sheets(2) 
Sheets("ChocoStrawb").Select 
Sheets("ChocoStrawb").Move Before:=Sheets(3) 
Sheets("Bronze").Select 
Sheets("Bronze").Move Before:=Sheets(4) 
Sheets("Silver").Select 
Sheets("Silver").Move Before:=Sheets(5) 
Sheets("Gold").Select 
Sheets("Gold").Move Before:=Sheets(6) 
Sheets("Champagne").Select 
End Sub

这我的整个代码..现在在“巧克力片和“水床我想要在同一行上的同一个房间，如果它们对于病情有效，即使它们是不同的状态。

来源

2017-02-27 JohanEs

这是很难帮助你只用一行的代码来看待。（特别是当这段代码引用ActiveCell右侧的3列时，这取决于ActiveCell的含义，将在D列或更晚的列表中显示，但您的数据似乎在C列中有信息。）请将其余代码粘贴到问题中，以便我们可以帮助您。 – YowE3K

@ YowE3K，我编辑了我的问题请你看一看 – JohanEs

通常我会认为接受挑战来整理代码是很有趣的，这样我就可以理解它足以解决什么是错误的，但是你需要处理所有事情在一个子例程中（而不是将代码分解为更小的块，以便更容易管理）意味着我甚至不会考虑这个问题。 – YowE3K

假设您的数据是：

在 “mySheetName”
列从A到d
与第一行后命名为 “头” 工作
一个
与所有记录在连续范围内共享相同的“代码”

那么你可以使用：

Option Explicit 

Sub main() 
    Dim code As Variant 

    With Sheets("mySheetName") '<--| change "mySheetName" to your actual sheet name 
     With .Range("D1", .cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:D range from row 1 (header) down to the one corresponding to last column A not empty row 
      DeleteSilverAndBronzeRecords .cells '<--| delete all records with "SILVER" or "BRONZE" in columnn "C" 
      For Each code In GetCodes(.Resize(.Rows.Count - 1, 1).Offset(1)) '<-- loop through unique "codes" starting from 2nd row downwards 
       If Application.WorksheetFunction.CountIf(.cells, code) > 1 Then HandleCodes .cells, code '<--| if more then one current 'code' occurrences then "handle" it 
      Next 
     End With 
    End With 
End Sub 


Sub DeleteSilverAndBronzeRecords(rng As Range) 
    With rng 
     .AutoFilter Field:=3, Criteria1:=Array("GOLD", "SILVER", "BRONZE"), Operator:=xlFilterValues '<--| filter column C cells with "GOLD", "SILVER" or "BRONZE" 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filtered cell other than headers 
      Application.DisplayAlerts = False 
      .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete '<-- delete filtered cells, skipping headers 
      Application.DisplayAlerts = True 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Sub 

Sub HandleCodes(rng As Range, code As Variant) 
    Dim cell As Range 
    Dim iCell As Long, refvalue As Long 
    Dim strng As String 

    With rng 
     .AutoFilter Field:=1, Criteria1:=code '<--| filter column A cells with current 'code' 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then 
      With .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible) '<-- reference filtered cells, skipping headers 
       For Each cell In .cells '<--| loop through filtered cells 
        strng = strng & Join(Application.Transpose(Application.Transpose(cell.Offset(, 1).Resize(, 2).Value)), " ") & " " '<--| build concatenated string from all current 'code' records 
       Next 
       .cells(1, 2).Value = WorksheetFunction.Trim(strng) '<--| write updated column "B" content in first record with current "code" 
       Application.DisplayAlerts = False 
       .Resize(.Rows.Count - 1).Offset(1).Delete '<--| delete all current "code" occurrences from the 2nd one on 
       Application.DisplayAlerts = True 
      End With 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Sub 

Function GetCodes(rng As Range) As Variant 
    Dim cell As Range 
    With CreateObject("Scripting.Dictionary") 
     For Each cell In rng 
      .Item(cell.Value) = cell.Value 
     Next cell 
     GetCodes = .keys 
    End With 
End Function

来源

2017-02-27 10:24:26 user3598756

尝试编辑代码 – user3598756

@JohanEs，你通过它了吗？ – user3598756

你可以请再看一遍......我编辑了我的问题...... – JohanEs

在Excel ---首页---条件格式---高亮度小区的规则----重复值---（选择范围，做）让我知道如果你需要更多的

来源

2017-02-27 01:55:50

这不只是突出重复？ – YowE3K

它会突出测试现在和基于颜色只是排序 –

很难将多行排序到一行。（我认为**是OP正在尝试做的事情 - 但他们没有真正说出他们有什么问题 - 我不确定问题中的第二组数据是“期望”输出还是“当前”输出在某种程度上与“期望”不匹配。） – YowE3K

如何对齐在同一行重复在Excel中VBA

回答

相关问题