標題: [發問] 求解vba程式 [打印本頁]

---

作者: peter631114    時間: 2019-5-18 15:40     標題: 求解vba程式

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


[attach]30627[/attach]

---

作者: kim223824    時間: 2019-5-19 10:02

回復 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

[attach]30632[/attach]

---

作者: peter631114    時間: 2019-5-20 11:00

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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)