返回列表 上一主題 發帖

[發問] 求解vba程式

[發問] 求解vba程式

hi 版主
有個問題想問vba程式要如何撰寫?詳細資料請參考附件

問題解釋

Snap1.jpg
2019-5-18 15:35



Data.rar (22.76 KB)

回復 1# peter631114

Sub 更新_20190519()

    ROW1 = Cells(Rows.Count, "C").End(3).Row
     
    Range("C2").Select
    '排序===============================================================
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("C2:C" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("L2:L" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("資料").Sort
        .SetRange Range("A1:M" & ROW1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets(1).Copy after:=Sheets(Sheets.Count)
    Range("A2:M" & ROW1).ClearContents
    k = ActiveCell.Row
    Sheets(1).Select
    For i = 2 To ROW1
        If Cells(i, "C") = Cells(i + 1, "C") And Cells(i, "L") = Cells(i + 1, "L") Then
            Range(Cells(i, "A"), Cells(i + 1, "M")).Copy Sheets(Sheets.Count).Cells(k, "A")
        k = k + 2
        End If
      Next

End Sub

Data.zip (32.59 KB)

TOP

謝謝大大,我試試看,有問題再問大大
真的感恩

TOP

        靜思自在 : 稻穗結得越飽滿,越會往下垂,一個人越有成就,就要越有謙沖的胸襟。
返回列表 上一主題