〔VBA〕範例：整菜工具，你也可以這樣做!--v012

【這是一支專為我個人常態性的團菜所做的小工具】

是的…工具不僅僅是在工作上使用…
倘若能幫助到生活上更簡便的處理"例行性"雜事，不也挺美好的…哈哈哈…

今天就小分享一支我自己個人的小工具…
當然…再強調一下，這是for我個人使用，且只做我需要的功能…僅此而以…

那…分享來做什麼呢??
單純就是給大家一個範例…Excel也可以這麼做…

先看看這支工具到底是在幹嘛…

由來：
我在公司定期團菜，菜的品項從google表單來，每次內容都會有變動，但「格式相同」★★
所以我會從網路的表單上複製品項資料，貼到Excel表中…利用VBA程式，按個鈕就將以下幾件事「自動完成」
1. 擷取各品項之「單價」，以便後續自動計算總價。
2. 將品項說明自動放入「註解」，這樣節省版面又方便查看。
3. 設定左方A、B欄各品項的總計包數及金額。
4. 設定上方E~K每個人員訂購的總計包數及金額。
5. 設定中間訂購輸入區的「格式化條件的設定」自動變底色。
以上功能的程式碼如下，細節我不特別說明…有問題請到小講堂來找我唷!
Sub VSetting()
    '整理蔬菜項目
    Dim iRow As Integer: iRow = 6
    Dim strV As String
    Dim blV As Boolean: blV = False
    Do While Range("C" & iRow) <> ""
        strV = Trim(Range("C" & iRow))
        If InStr(strV, "NT$") > 0 Then
            blV = True
            '設定價格
            Range("D" & iRow) = CInt(Mid(strV, InStr(strV, "$") + 1, Len(strV) - InStr(strV, "$") - 1))
            '設定A、B欄公式
            Range("A" & iRow).Formula = "=IF(SUM(E" & iRow & ":K" & iRow & ")=0," & """" & """" & ",SUM(E" & iRow & ":K" & iRow & "))"
            Range("B" & iRow).Formula = "=IF(A" & iRow & "=" & """" & """" & "," & """" & """" & ",A" & iRow & "*D" & iRow & ")"
            '設定格式化條件
            Range("A" & iRow & ":K" & iRow).Select
            Selection.FormatConditions.Delete
            Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A" & iRow & "<>"""""
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With Selection.FormatConditions(1).Interior
                .Color = 16774629
            End With
            
            iRow = iRow + 1
        Else
            If blV = True Then
                '下一筆為菜說明
                If Not Range("C" & iRow - 1).Comment Is Nothing Then Range("C" & iRow - 1).Comment.Delete
                Range("C" & iRow - 1).AddComment strV
                'Range("C" & iRow - 1).Comment.Shape.TextFrame.AutoSize = True
                Range("C" & iRow - 1).Comment.Shape.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
                Range("C" & iRow - 1).Comment.Shape.ScaleWidth 3, msoFalse, msoScaleFromTopLeft
                blV = False
            End If
            Range(iRow & ":" & iRow).EntireRow.Delete
        End If
        If iRow > 1000 Then Exit Sub '防死迴圈
    Loop
    '處理表頭公式
    Range("A4").Formula = "=SUM(A6:A100)"
    Range("B4").Formula = "=SUM(B6:B100)"
    Range("E4").Formula = "=SUM(E6:E100)": Range("E5").Formula = "=SUMPRODUCT($D6:$D100,E6:E100)"
    Range("F4").Formula = "=SUM(F6:F100)": Range("F5").Formula = "=SUMPRODUCT($D6:$D100,F6:F100)"
    Range("G4").Formula = "=SUM(G6:G100)": Range("G5").Formula = "=SUMPRODUCT($D6:$D100,G6:G100)"
    Range("H4").Formula = "=SUM(H6:H100)": Range("H5").Formula = "=SUMPRODUCT($D6:$D100,H6:H100)"
    Range("I4").Formula = "=SUM(I6:I100)": Range("I5").Formula = "=SUMPRODUCT($D6:$D100,I6:I100)"
    Range("J4").Formula = "=SUM(J6:J100)": Range("J5").Formula = "=SUMPRODUCT($D6:$D100,J6:J100)"
    Range("K4").Formula = "=SUM(K6:K100)": Range("K5").Formula = "=SUMPRODUCT($D6:$D100,K6:K100)"
    

End Sub

另外最上方，在每次輸入訂購量時，自動更新及彙整「訂購品項及包數」(為了一目了然)的程式碼如下：
(寫在工作表中)
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 5 And Target.Column > 4 Then
        '直接重算那一欄
        Dim iRow As Integer: iRow = 6
        Dim strVA As String, strV As String
        Range("C1") = "": Cells(1, Target.Column) = ""
        Do While Range("C" & iRow) <> ""
            If Range("A" & iRow) <> "" Then
                strVA = strVA & Range("C" & iRow) & "×" & Range("A" & iRow) & vbCrLf
            End If
            If Cells(iRow, Target.Column) > 0 Then
                strV = strV & Range("C" & iRow) & "×" & Cells(iRow, Target.Column) & vbCrLf
            End If
            iRow = iRow + 1
        Loop
        Range("C1") = strVA
        Cells(1, Target.Column) = strV
    End If

End Sub

★★範例檔下載★★

章老師的電腦小講堂 https://www.facebook.com/ScenicSchool/

※※ 本區做為經常使用之程式碼複製區，提問請至小講堂唷 ※※

Search Post

Label :