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

查看编号1010 ..

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

你能帮助我吗？

在3月7日添加，这是我的整个宏（我不想要另一个Sub）：

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

这是我的整个代码..现在在'巧克力床单和'水床下，如果它们对于该条件有效，我想在同一排上使用相同的舱室，即使它们处于不同状态。

Answer 1

在excel ---首页---有条件的格式化---突出显示细胞规则----重复值---（选择你的范围和做）让我知道，以防你需要更多

Answer 2

假设您的数据是：

以“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

如何在VBA中的Excel中的相同行上对齐重复项

2 个答案: