[VBA] Copy by Button

[poipoi]

เรียนอาจารย์ทุกท่านครับ

จากไฟล์แนบครับ มีปัญหาเกี่ยวกับ setup code ให้ทำการ copy โดยใช้ Button Controls ครับ

โดนที่ผมต้องการให้มัน copy ที่ B3:D9 โดยเงื่อนไขคือ ใน B2 จะต้องมีข้อความอยู่ครับ

ในเบื้องต้นผมได้ลองเขียนให้มัน copy ได้ แต่มันจะต้องไปกำหนดที่ B2 ตายตัวครับ

เพราะว่าในอนาคตอาจจะมีการ เพิ่ม โดยการ copy ตารางเหล่านั้นครับ

ปัญหาคือ ผมต้องการเพียง 1 กลุ่มชุดคำสั่งที่จะสามมรถสั่งทำงานในทุกตารางได้โดยใช้แค่การ add sign macro เข้าไปครับ

เพราะเวลา copy ทั้งตาราง Button มันจะติดมาด้วยจะได้ไม่ต้อง as sign macro ให้มันใหม่ครับ

ขอบคุณครับ

หากมีปตรงไหนไม่เข้าใจรบกวนถามได้เลยครับ

[snasui]

การที่จะเขียน Code ให้ Dynamic ได้จะต้องทราบว่าเงื่อนไขมีอะไรบ้าง ช่วยแจ้งเงื่อนไขมาด้วยครับ

[poipoi]

1. Button Click

เงื่อนไขคือสามารถ copy ตั้งแต่ Name 1 ที่ Column 11 จนถึง Country ที่ Column 17 ได้ครับโดยไม่สนใจว่าจะมีข้อมูลหรือไม่

ส่วนช่องอื่นก็ทำแบบเดียวกันครับ

คือสิ่งที่ผมทำต้องมานั่ง assign macro เองทุกตัวตามไฟล์แนบครับ

ฉะนั้นจึงอยากขอคำแนะนำจากอาจารย์ครับว่าพอจะมีทางย่อ code ได้หรือไม่ครับ

จากไฟล์แนบที่ Row 10 column C : D จะมี Button click อยู่ 2 อันครับ ลองกดดูได้ครับ

2. Upper Case

ในส่วนการทำ Upper case ที่ได้เคยถามอาจารย์ไปนั้น ผมต้องใส่ช่วงของ range เองจึงอยากถามอาจารย์ว่า

เราสามารถใช้ code เดียวได้หรือไม่ โดยเงื่อนไขคือต้องการให้มัน upper เฉพาะ cells ที่มีสีฟ้าครับ

Code: Select all

    For Each R In Range("B23:D28,B34:D39,B45:D50,B56:D61,B67:D72,B78:D83,B89:D94,B100:D105,B111:D116,B122:D127,B133:D138,B144:D149,B155:D160,F23:I28,F34:I39,F45:I50,F56:I61,F67:I72,F78:I83,F89:I94,F100:I105,F111:I116,F122:I127,F133:I138,F144:I149,F155:I160,C15")
        R = UCase(R)
    Next R

อันนี้คือที่ใช้อยู่ครับ เพราะว่าที่อยู่นั้นมันไม่คงที่มีเพิ่มได้เรื่อยๆครับจึงไม่อยากให้ให้มันอัพเดทได้เอง

3. Drop Down List

ที่ Column C:D Row 17 จะมี drop down สำหรับการเลือกประเทศอยู่ครับ

- ซึ่งมันไม่สามารถใช้ Scroll Mouse ในการเลื่อนขึ้นลงได้ครับ จึงอยากถามว่าพอมีทางไหนบ้างที่จะสามารถจัดการตรงส่วนนี้ได้

- จะมีทางไหนบ้างครับที่เวลาพิมพ์ตัวอักษาลงไปแล้วทั้งคำจะขึ้นมาเองเหมือนเวลาพิมพ์สูตรครับ

; เช่นประเทศ Thailand พิมพ์แค่ T หรือ Th ก็จะมี Thailand ขึ้นมาทั้งคำ ครับ

ขอบคุณครับ

[snasui]

ตัวอย่างการปรับ Code ให้เลือกเฉพาะสีฟ้าและปรับให้เป็นอักษรตัวใหญ่พร้อม Copyตามด้านล่างครับ

Code: Select all

Sub test()
    Dim rAll As Range, r As Range
    Dim blueRange As Range, bl As Range
    With Sheets("Addresses")
        Set rAll = .Range("a10", .Range("a" & Rows.Count) _
            .End(xlUp))
        Set rAll = Union(rAll, rAll.Offset(0, 4))
    End With
    For Each r In rAll
        If r.Value = "Search Key:" Then
            Set blueRange = r.Offset(1, 1).Resize(7, 3)
            For Each bl In blueRange
                bl = UCase(bl)
            Next bl
        End If
        blueRange.Copy
        'other code
    Next r
End Sub

สำหรับ Dropdown หากต้องการใช้ Scroll Mouse ต้องนำเมาส์ไปชี้ที่ Vertical Scroll Bar ก่อนแล้วค่อย Scroll Mouse ส่วนการคีย์อักษรบางตัวแล้วให้เลือกอักษรทีใกล้เคียงต้องพึ่ง VBA ซึ่งไม่ง่ายครับ

[poipoi]

สำหรับ Drop down list และ Upper case สามารถใช้งานได้แล้วครับ ขอบคุณครับ

แต่ข้อที่หนึ่งผมยังคงต้องการคำแนะนำอยู่ครับเพราะใน module มันยาวมากๆเลยครับ

[snasui]

ผมตอบไปแล้วทุกข้อที่ถามมา ไม่ทราบว่าตามที่ตอบไปนั้นในส่วนของข้อ 1 ได้นำไปทดสอบแล้วหรือไม่ ติดขัดตรงไหนครับ

[poipoi]

อ่อ สิ่งที่ต้อ
การในข้อ 1 นั้นคือเวลากด button แล้วให้ copy เฉพาะ address นั้นๆครับ

จาก code เหมือนจะไป copy address สุดท้ายเท่านั้นครับ

ขอบคุณครับ

[snasui]

ตัวอย่างการปรับ Code ให้เลือกเฉพาะสีฟ้าและปรับให้เป็นอักษรตัวใหญ่พร้อม Copyตามด้านล่างครับ

ลองแนบไฟล์ที่ลองทำมาแล้วและช่วยอธิบายว่าต้องการคำตอบเป็นอย่างไร Code ที่ผมเขี่ยนไปนั้นผมเขียนไว้ชัดเจนแล้วว่าต้องการจะทำอะไร

ในส่วนของ 'other code คือ Code ทีคุณต้องเขียนการวางเอาเองครับ

[poipoi]

เรียนอาจารย์

Code: Select all

Sub copy_000()
    ActiveSheet.Range("B10").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_001()
    ActiveSheet.Range("B22").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_002()
    ActiveSheet.Range("F22").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_003()
    ActiveSheet.Range("B33").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

code ข้างต้นนี้คือ code ที่อบู่ในไฟล์แนบครับ

คือผมต้องรัน code ตัวนี้ตั้งแต่ 000 - 100 ก็คือต้องมีแบบนี้ถึง 100 ตัว

ผมจึงคิดว่ามันจะยาวไปครับ จึงอยากขอคำแนะนำจากอาจารย์ครับ

ขอบคุณครับ

[snasui]

กำลังจะวนมาที่เดิมครับ ผมตอบไปแล้วตามนี้ครับ

ตัวอย่างการปรับ Code ให้เลือกเฉพาะสีฟ้าและปรับให้เป็นอักษรตัวใหญ่พร้อม Copyตามด้านล่างครับ

Code: Select all

Sub test()
    Dim rAll As Range, r As Range
    Dim blueRange As Range, bl As Range
    With Sheets("Addresses")
        Set rAll = .Range("a10", .Range("a" & Rows.Count) _
            .End(xlUp))
        Set rAll = Union(rAll, rAll.Offset(0, 4))
    End With
    For Each r In rAll
        If r.Value = "Search Key:" Then
            Set blueRange = r.Offset(1, 1).Resize(7, 3)
            For Each bl In blueRange
                bl = UCase(bl)
            Next bl
        End If
        blueRange.Copy
        'other code
    Next r
End Sub

สำหรับ Dropdown หากต้องการใช้ Scroll Mouse ต้องนำเมาส์ไปชี้ที่ Vertical Scroll Bar ก่อนแล้วค่อย Scroll Mouse ส่วนการคีย์อักษรบางตัวแล้วให้เลือกอักษรทีใกล้เคียงต้องพึ่ง VBA ซึ่งไม่ง่ายครับ

ไม่ทราบว่าได้นำไปทดสอบแล้วหรือไม่ครับ อย่าลืมที่เขียนว่า 'other code คุณจะต้องเขียนเพิ่มเองว่าให้วางที่ไหนครับ

[poipoi]

จากการทดลองพบว่า มันจะไป copy เฉพาะ address สุดท้ายที่เดียวครับ

สิ่งที่ต้องการคือเวลาเราคลิกที่ address ไหนแล้วให้มันเลือกเฉพาะที่ address นั้นครับ

ผมต้องการให้มัน copy อย่างเดียวเพื่อที่จะเอาไปวางในระบบ เพราะเวลาเล็งแล้วคลุมเองมันค่อนข้างเสียเวลาครับ

จึงอยากจะขอคำแนะนำอาจารย์ครับว่าผมควรจะต้องแก้ตรงไหนบ้างครับ

ขอบคุณครับ

[snasui]

คุณได้ลอง Run ทีละ Step ด้วยการกด F8 แล้วซ้ำ ๆ แล้ววังเกตว่าเป็นการ Copy เฉพาะ Address สุดท้ายอย่างที่เข้าใจหรือไม่

Code ที่ผมเขียนไปนั้นเป็นการ Loop ให้ Copy ทุกพื้นที่ตามเงื่อนไข สิ่งที่คุณต้องเขียนเพิ่มคือการวางในทุกครั้งที่ Copy ครับ

[poipoi]

เรียนอาจารย์ครับ

ผมได้ลอง run ด้วย F8 ดูแล้วครับสุดท้ายมันก็จะไป copy ที่ช่อง address สุดท้ายอยู่ดีครับ

แล้วจะเป็นไปได้ไหมหากจะแยก upper กับ copy ออกจากกัน (ให้เป็นคนละ Procedure)

ขอบคุณครับ

[snasui]

ผมยืนยันว่าเป็นการ Copy ทุกพื้นที่ตามที่เขียนไปด้านบน

กรณีที่ติดปัญหาจะต้องยก Code ที่นำไปปรับใช้แล้วติดปัญหามาถามกัน ไม่ควรแจ้งปัญหาเดิม ๆ ในแบบที่ไม่เห็นการนำไปปรับใช้

สำหรับการเขียน Code จะต้องปรับเองได้บ้าง ถ้าปรับเองไม่ได้ผมไม่แนะนำให้ใช้ Code ครับ

การแยกหน้าที่กันไม่ใช่ปัญหาในการใช้ VBA ครับ

[poipoi]

เรียนอาจารย์ครับ

ผมได้ลองพยายามแก้ไขโค้ดได้ตัวเองแล้วปรากฎว่า มันก้ยังงงไปส่วนสุดท้ายอยู่ดี

แล้วถ้าผมใช้ code แบบนี้ละครับ ??

Code: Select all

Sub test1()
Application.ScreenUpdating = False

Dim r1, r2, rAll, blue As Range
Dim r As Variant

Worksheets("Addresses").Select
    Set r1 = Range("a10", Range("a" & Rows.Count).End(xlUp))
    Set r2 = r1.Offset(0, 4)
    Set rAll = Union(r1, r2)

If  ********************

    For Each r In r1
        If r.Value = "Search Key:" Then
            Set blue = r.Offset(1, 1).Resize(7, 3)
                blue.Select
                Selection.Copy
        End If
    Next r
    
Else
    
    For Each r In r2
        If r.Value = "Search Key:" Then
            Set blue = r.Offset(1, 1).Resize(7, 3)
                blue.Select
                Selection.Copy
        End If
    Next r
    
End If

Application.ScreenUpdating = True
End Sub

ในโค้ดที่ดอกจันทร์เอาไว้ควรจะใส่เป็นอะไรดีครับ

แล้วพอดีผมลองอีกวิธีหนึ่งด้วยการ ให้ cursor ไปไว้ตรง Name 1 แล้วใช้ code ตามนีเครับ

Code: Select all

Sub MultiCopy()
Dim i As Variant

If ActiveCell.Column = 2 Then
    Range(ActiveCell.Offset(i * 11).Address(False, False) & ":" & Cells(ActiveCell.Row, ActiveCell.Column + 2).Offset(i * 11).Offset(6).Address(False, False)).Copy
Else
    Range(ActiveCell.Offset(i * 11).Address(False, False) & ":" & Cells(ActiveCell.Row, ActiveCell.Column + 3).Offset(i * 11).Offset(6).Address(False, False)).Copy
End If
End Sub

พอจะมีทางไหนครับที่ไม่ต้องให้เม้าไปจิ้มที่ name1 เสมอ

แล้วก็มีอีก 1 ปัญหาครับแต่ไม่ได้เกี่ยวข้องกับส่วนนี้ผมขออนูญาติไปเริ่มหัวข้อใหม่ครับ

ขอบคุณครับ

[snasui]

ควรไปถามต่อตามที่เขียนไว้ครับ [VBA] Looping range

[poipoi]

รับทราบครับ

ขอบคุณครับ