Excel VBA 簡化很多IF方法?

excel vba

j2sn021108 2023-03-29 01:55:13 ‧ 2005 瀏覽

分享至

各位大神好新手發問 (初學1週)

因要查找sheet(原始清單).Range("A1:I1")的表頭名稱，若查找符合就依該欄複製並貼置sheet(複製清單)的指定欄位，但不知道怎麼寫，只好用好幾個For Each IF，請問這要怎麼簡化？
整理程式碼怎麼寫比較符合邏輯，請大神指教，謝謝。

Sub FindColumn()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range, cell2 As Range, cell3 As Range, cell4 As Range, cell5 As Range, cell6 As Range
    Dim columnNumber As Long
    Dim lastRow As Long

lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

    Set ws = Worksheets("原始資料")
    Set rng = ws.Range("A1:I1")
    columnNumber = 0

    For Each cell In rng
        If cell.Value = "D數" Then
            columnNumber = cell.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("A1").Select
            ActiveSheet.Paste
            Exit For
        End If
Next
    For Each cell2 In rng
        If cell2.Value = "Near" Then
            columnNumber = cell2.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("B1").Select
            ActiveSheet.Paste
            Exit For
        End If
Next
    For Each cell3 In rng
        If cell3.Value = "Int" Then
            columnNumber = cell3.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("C1").Select
            ActiveSheet.Paste
            Exit For
        End If
Next
    For Each cell4 In rng
        If cell4.Value = "GTIN" Then
            columnNumber = cell4.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("D1").Select
            Selection.PasteSpecial
            Exit For
        End If
Next
    For Each cell5 In rng
        If cell5.Value = "代碼" Then
            columnNumber = cell5.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("E1").Select
            ActiveSheet.Paste
            Exit For
        End If
Next
    For Each cell6 In rng
        If cell6.Value = "半成品序號" Then
            columnNumber = cell6.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range("F1").Select
            ActiveSheet.Paste
            Exit For
        End If
Next
Application.CutCopyMode = False
MsgBox "複製完成!"

End Sub

居然解出來了 iT邦好手 1 級 ‧ 2023-03-29 14:37:45 檢舉

一句話：把相似的動作提取出來做函數

孫守真任真甫 iT邦研究生 4 級 ‧ 2023-03-29 15:33:17 檢舉

菩薩慈悲：就末學所知用個變數（數組（陣列）或 Collection 或 Scripting.Dictionary）來記下您要找的範圍就行了。簡化有很多方法，各菩薩的回答也都中肯。菩薩若不棄再與我聯繫，末學也是全自學來的。感恩感恩　南無阿彌陀佛

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

5 個回答

japhenchen

iT邦超人 1 級 ‧ 2023-03-29 07:38:13

這是我幫你提問BING(GPT-4)的回答

您可以使用一個For循環和Select Case語句來簡化您的程式碼。這樣可以避免重複的For循環和If語句。以下是一個示例：

Sub FindColumn()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim columnNumber As Long
    Dim lastRow As Long

    lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

    Set ws = Worksheets("原始資料")
    Set rng = ws.Range("A1:I1")
    columnNumber = 0

    For Each cell In rng
        Select Case cell.Value
            Case "D數"
                columnNumber = cell.Column
                ws.Select
                Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
                Sheets("複製清單").Select
                Range("A1").Select
                ActiveSheet.Paste
            Case "Near"
                columnNumber = cell.Column
                ws.Select
                Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
                Sheets("複製清單").Select
                Range("B1").Select
                ActiveSheet.Paste
            Case "Int"
                columnNumber = cell.Column
                ws.Select
                Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
                Sheets("複製清單").Select
                Range("C1").Select
                ActiveSheet.Paste
            Case "GTIN"
                columnNumber = cell.Column
                ws.Select
                Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
                Sheets("複製清單").Select
                Range("D1").Select
                Selection.PasteSpecial
            Case "代碼"
                columnNumber = cell.Column
                ws.Select
                Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
                Sheets("複製清單").Select
                Range("E1").Select
                ActiveSheet.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        End Select

    Next

End Sub

回應 2
分享
檢舉

japhenchen iT邦超人 1 級 ‧ 2023-03-29 07:41:36 檢舉

看來我得好好考慮換跑道了，至少chatGPT不會做吃的

孫守真任真甫 iT邦研究生 4 級 ‧ 2023-03-29 15:28:24 檢舉

japhenchen菩薩慈悲：應該是說，「和chatGPT大菩薩合作創業了」（換跑道了）。感恩感恩　讚歎讚歎　南無阿彌陀佛

登入發表回應

kakaoweilolz

iT邦新手 5 級 ‧ 2023-03-29 08:22:42

你可以嘗試將關鍵字放入Array中，使用多重迴圈來實現逐個查找。
也建議減少Select的使用，可以加快查找的速度。
除了序號外，其他的可依實際情況去做調整。

Sub FindColumn()
    'Sht1．查找表單名稱、Sht2．存放表單名稱
    Dim Sht1 As String
    Dim Sht2 As String
    Sht1 = "原始資料"
    Sht2 = "複製清單"
    
    '查找的欄位數量．（A-1、B-2、C-3...I-9）
    Dim ColumnNum As Integer
    ColumnNum = 9
    
    '表頭關鍵字
    Dim Keywords As Variant
    Keywords = Array("D數", "Near", "Int", "GTIN", "代碼", "半成品序號")
    
    '序號
    Dim LCount As Byte
    LCount = 1

    Sheets(Sht1).Select
    Sheets(Sht2).Cells.ClearContents
    
    For i = 1 To ColumnNum
        For f = 0 To UBound(Keywords)
            If (Cells(1, i).Value = Keywords(f)) Then
                Range(Cells(1, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i)).Copy
                Sheets(Sht2).Cells(1, LCount).PasteSpecial xlPasteValues
                LCount = LCount + 1
            End If
        Next
    Next
    
End Sub

回應
分享
檢舉

登入發表回應

blanksoul12

iT邦研究生 5 級 ‧ 2023-03-29 09:02:02

寫 vba 的 sql

回應
分享
檢舉

登入發表回應

海綿寶寶

iT邦大神 1 級 ‧ 2023-03-29 22:15:19

Sub FindColumn()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range, cell2 As Range, cell3 As Range, cell4 As Range, cell5 As Range, cell6 As Range
    Dim columnNumber As Long
    Dim lastRow As Long

    lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

    Set ws = Worksheets("原始資料")
    Set rng = ws.Range("A1:I1")
    columnNumber = 0
    
    For Each cell In rng
        Address = ValueToAddress(cell.value)
        If Address <> "N/A" Then
            columnNumber = cell.Column
            ws.Select
            Range(Cells(1, columnNumber), Cells(lastRow, columnNumber)).Copy
            Sheets("複製清單").Select
            Range(Address).Select
            ActiveSheet.Paste
        End If
    Next
    Application.CutCopyMode = False
    MsgBox "複製完成!"
End Sub
Function ValueToAddress(ByVal value)
    result = "N/A"
    If value = "D數" Then
        result = "A1"
    ElseIf value = "Near" Then
        result = "B1"
    ElseIf value = "Int" Then
        result = "C1"
    ElseIf value = "GTIN" Then
        result = "D1"
    ElseIf value = "代碼" Then
        result = "E1"
    ElseIf value = "半成品序號" Then
        result = "F1"
    End If
    ValueToAddress = result
End Function

回應
分享
檢舉

登入發表回應

haiyen_lee

iT邦新手 5 級 ‧ 2023-03-30 22:05:50

以前我也習慣用先選範圍(Select)複製後再選要貼上的範圍再貼上值，後來有一次將程式寫在工作表物件(Worksheet)的事件上(如Worksheet_Deactivate())時，發生嚴重的錯誤後就再也不用這種方法複製了。
後來都直接給值(如 Sheets("工作表1").Range("C:C").Value = Sheets("工作表2").Range("B:B").Value) 這樣的好處是不會改變原先所選的工作表、儲存格也就不會不小心觸發不該觸發的事件。
慘痛經驗僅供參考。