Question

这是我的情况..

我有这个文件：

   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栏：第一＆amp;姓氏

D栏：状态（青铜，银等......）

E栏：会员编号

如果A列相同，我希望它在同一行。但它不包括状态铜牌，银牌，金牌，所以我把它放在我的VBA中以排除那些：

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

当我运行宏时，它给了我这个：

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

Column B: Cabin number
Column C: Mr/Mme + Name of guest 1
Column D:Status (Platin, PLPLUS etc..)
Column E : Mr/Mme + Name of Guest 2
Column F: Status

查看编号1010 ..

不知何故，两者都处于这种状态，但由于它们具有不同的状态，因此宏将它们放在不同的行中而我不希望这样，我希望它们在同一行中。

我想要这个：

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  Mrs  Mary Wilson        PLPLUS

这是我的代码，名为“ChocoStrawb”。

  ' 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

这是我的整个代码：

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

Sheets("Champagne").Select
Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
LastRow = Range("B2").End(xlDown).Row
Cells(LastRow + 2, "B").Formula = "=SUM(B2:B" & LastRow & ")"
LRowA = [B4200].End(xlUp).Address
Range("B:B").Interior.ColorIndex = xlNone
Range("B2:" & LRowA).Interior.ColorIndex = 33
Range("B:B").HorizontalAlignment = xlCenter

Sheets("ChocoStrawb").Select
Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
LastRow = Range("B2").End(xlDown).Row
Cells(LastRow + 2, "B").Formula = "=SUM(B2:B" & LastRow & ")"
LRowA = [B4200].End(xlUp).Address
Range("B:B").Interior.ColorIndex = xlNone
Range("B2:" & LRowA).Interior.ColorIndex = 33
Range("B:B").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

Answer 1

很难准确地（根据您的示例）确定故障发生的位置。在最初的示例中，您显示1010与其他示例一样重复，然后在第二个示例中您不显示相同的数据（仅1010显示为重复）。我本来期望将1004个重复项向上移动以查看所有内容，这是在第一个示例中，但不是在第二个示例中。

假设我关注，我建议保持排序，然后使用activecell.formula来确定移动到哪里，只需使用VBA。循环并确定哪些线条相同，然后移动您需要的项目;剪切/粘贴后，删除该行。

Dim i as Integer

For i = 3 to 4200 '4200 taken from your range.  starting at 3 because range starts at 2 (i-1)

    If Cells(i-1,1).Value=Cells(i,1).Value Then
        Range(Cells(i,2),Cells(i,4)).Cut Range(Cells(i-1,5),Cells(i-1,7))
        Row(i).Delete
    End If

Next i

编辑：

您也应该能够缩短排序时间：

Sheets("ChocoStrawb").Range("A1:H4200).Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes

基本上，您的整个代码可以整理您的工作表，让人们共享一个小屋。然后删除空行，看起来像这样：

Dim i as Integer

Sheets("ChocoStrawb").Range("A1:H4200).Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes

For i = 3 to 4200 '4200 taken from your range.  starting at 3 because range starts at 2 (i-1)

With Sheets("ChocoStrawb")

    If .Cells(i-1,1).Value=.Cells(i,1).Value Then
        .Range(Cells(i,2),Cells(i,4)).Cut .Range(Cells(i-1,5),Cells(i-1,7))
        .Row(i).Delete
    End If

End With

Next i

这应该是一个整体改进。尽量避免在编码中选择/激活，因为这会使步骤复杂化。

Answer 2

考虑使用Windows Jet / ACE SQL引擎的SQL解决方案。但需要做两件事：1）使用Excel for Windows和2）添加列名作为数据的顶部标题。下面假设数据位于名为 DATA 的选项卡和名为 RESULTS 的现有选项卡中以保存SQL结果。包括两种连接类型。

Public Sub RunSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' DRIVER AND PROVIDER CONNECTION TYPES
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsm;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsm';" _
                       & "Extended Properties=""Excel 12.0;HDR=YES;"";"

    strSQL = " SELECT t1.[CabinNumber], t1.[Mr./Mrs.], t1.[First & Last Name], t1.Status, " _
                & "   t2.[Mr./Mrs.], t2.[First & Last Name], t2.Status" _
                & " FROM [DATA$] t1 INNER JOIN [DATA$A] t2" _
                & " ON t1.[CabinNumber] = t2.[CabinNumber]" _
                & " WHERE NOT t1.Status IN ('Gold', 'Silver', 'Bronze')"

    ' OPEN DB CONNECTION
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For i = 1 To rst.Fields.Count
        Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
    Next i    

    ' DATA ROWS
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    ' CLOSE OBJECTS AND FREE RESOURCES
    rst.Close: conn.Close
    Set rst = Nothing: Set conn = Nothing
End Sub

如何合并具有相同房间号但具有不同状态

2 个答案: