userform add and select copy

[Totem]

เรียนอาจารย์และเพื่อนสมาชิกทุกคน

ปํญหาการ select copy ขออธิบายดังนี้
1.เมื่อเปิด userform ขึ้นมาแล้ว รายการชื่อและแผนก ใน Listbox1 ทางด้านซ้ายจะแสดงรายการออกมาทั้งหมดแล้ว
2.ต่อมาเลือกกดปุ่ม ชื่อ แผนก 1 หรือ ชื่อ แผนก 2 ก็จะแสดงรายการ ใน Listbox2 ทางด้านขวาจะแสดงรายการออกมาทั้งหมดได้เรียบร้อยแล้ว
3.จากนั้นเลือก รายการ ชื่อ แผนก ใน Listbox1 ตามความต้องการ เมื่อเลือกรายการได้แล้ว
4.ทำการกดปุ่ม SAVE เพื่อ SAVE รายการใน Listbox1 ไปไว้ ใน Listbox 2 ว่าจะ SAVE ไปไว้ใน ชื่อ แผนก 1
หรือ ชื่อ แผนก 2
code ที่ได้เขียนขึ้นมา ทำการ SAVE CommandButton4_Click() ได้ครับ แต่ยังไม่ครอบคุลุมในสิ่งต้องการ

ปัญหา คือ SAVE แล้ว ต้องการให้ SAVE นำ ชื่อ และ แผนก มาวางไว้ที่แถวสุดท้าย โดยมาทั้ง ชื่อ และแผนก
เช่น Select ชื่อ ddddd แผนก asds5 ใน column I , J แล้ว ไปวางที่ ชื่อ 1 แผนก1 ใน column B , C
แต่ code ที่เขียน copy ชื่อ ddddd แผนก ccvcvc ซื่งไม่ได้ตามต้องการ ที่ต้องการคือ ชื่อ ddddd แผนก asds5
และการเลือก ชื่อ แผนก 1 หรือ ชื่อ แผนก 2 ผมเขียนให้อยู่ใน CommandButton4_Click()
พอเลือก ชื่อ แผนก 2 มาแสดงใน Listbox 2 ด้านขวา กด SAVE ไม่ copy ไปไว้ใน column D , C ครับ

Code: Select all

Private Sub CommandButton4_Click() ' SAVE

    Dim i, c As Integer
    Dim b, d As Integer

    For i = 0 To Me.ListBox2.ListCount - 1
    
     For c = 1 To Me.ListBox2.ListCount - 1

        If Me.ListBox1.Selected(i) = True Then

        Cells(Me.ListBox2.ListCount + 2, 2) = Me.ListBox1.List(i)
        Cells(Me.ListBox2.ListCount + 2, 3) = Me.ListBox1.List(c)
        
   End If
   
         Me.ListBox1.Selected(i) = False
         
    Next c
Next i


    For b = 0 To Me.ListBox2.ListCount - 1
    
     For d = 1 To Me.ListBox2.ListCount - 1

        If Me.ListBox1.Selected(b) = True Then

        Cells(Me.ListBox2.ListCount + 2, 4) = Me.ListBox1.List(b)
        Cells(Me.ListBox2.ListCount + 2, 5) = Me.ListBox1.List(d)
        
   End If
   
         Me.ListBox1.Selected(b) = False
         
    Next d
Next b
            
End Sub

ปัญหาที่ code นี้ ชื่อ1 แผนก1

Code: Select all

     For c = 1 To Me.ListBox2.ListCount - 1

Code: Select all

        Cells(Me.ListBox2.ListCount + 2, 2) = Me.ListBox1.List(i)
        Cells(Me.ListBox2.ListCount + 2, 3) = Me.ListBox1.List(c)

และ ที่ ชื่อ 2 แผนก 2

Code: Select all

     For d = 1 To Me.ListBox2.ListCount - 1

Code: Select all

        Cells(Me.ListBox2.ListCount + 2, 4) = Me.ListBox1.List(b)
        Cells(Me.ListBox2.ListCount + 2, 5) = Me.ListBox1.List(d)

ขอบคุุณครับ

add and select copy.xlsm

[snasui]

ตัวอย่าง Code ครับ

ประกาศตัวแปรไว้บนสุดของ Module เป็น

Code: Select all

Dim colSelect As Integer

จากนั้นปรับ Code ที่ CommandButton4_Click เป็นด้านล่าง

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    Dim c As Integer
    For c = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox1.Selected(c) = True Then
            With Worksheets("add")
                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 2).Value = .Range("i2").Offset(c, 0).Resize(1, 2).Value
            End With
            Me.ListBox1.Selected(c) = False
        End If
    Next c
End Sub

[Totem]

เรียนอาจาารย์
ปรับ code แล้ว ขึ้น Run-time error '1004': Application or object-defined error ครับ

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    
    Dim c As Integer
    For c = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox1.Selected(c) = True Then
            With Worksheets("add")
                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 2).Value = .Range("i2").Offset(c, 0).Resize(1, 2).Value
            End With
            Me.ListBox1.Selected(c) = False
        End If
    Next c
End Sub

Code: Select all

                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 2).Value = .Range("i2").Offset(c, 0).Resize(1, 2).Value

add and select copy.xlsm

[snasui]

ในไฟล์แนบยังไม่ได้มีการประกาศตัวแปรที่ผมแจ้งไปด้านบนครับ

เพิ่ม Code ในปุ่มชื่อแผนก 1 เป็น

Code: Select all

Private Sub CommandButton2_Click()
    Dim lRow1 As Long
    colSelect = 2    
    'Other code
End Sub

เพิ่ม Code ในปุ่มชื่อแผนก 2 เป็น

Code: Select all

Private Sub CommandButton3_Click()
    Dim lRow1 As Long
    colSelect = 4
    'Other code        
End Sub

[Totem]

ในไฟล์แนบยังไม่ได้มีการประกาศตัวแปรที่ผมแจ้งไปด้านบนครับ

เพิ่ม Code ในปุ่มชื่อแผนก 1 เป็น

Code: Select all

Private Sub CommandButton2_Click()
    Dim lRow1 As Long
    colSelect = 2    
    'Other code
End Sub

เพิ่ม Code ในปุ่มชื่อแผนก 2 เป็น

Code: Select all

Private Sub CommandButton3_Click()
    Dim lRow1 As Long
    colSelect = 4
    'Other code        
End Sub

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

ผมปรับ code ตามที่ได้มาแล้ว

Code: Select all

Private Sub CommandButton4_Click() ' SAVE

    Dim colSelect As Integer
    Dim c As Integer
       'Other code        
End Sub 

Code: Select all

Private Sub CommandButton2_Click()

Dim lRow1 As Long

    colSelect = 2

    lRow1 = Sheets("add").Range("B" & Rows.Count).End(xlUp).Row
        
        ListBox2.ColumnCount = 2
        ListBox2.RowSource = Sheets("add").Range(Cells(2, 2), Cells(lRow1, 3)).Address
        
End Sub

Code: Select all

Private Sub CommandButton3_Click()

Dim lRow1 As Long

    colSelect = 4
    
    lRow1 = Sheets("add").Range("D" & Rows.Count).End(xlUp).Row
        
        ListBox2.ColumnCount = 2
        ListBox2.RowSource = Sheets("add").Range(Cells(2, 4), Cells(lRow1, 5)).Address
        
End Sub

Code: Select all

                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 2).Value = .Range("i2").Offset(c, 0).Resize(1, 2).Value

ผมสังเกตุเห็นว่า colSelect .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) ได้ค่าเป็น 0 ไม่แสดง colSelect ที่แสดงจำนวน column ใน CommandButton2_Click() หรือ CommandButton3_Click()
หากเราจะเลือก CommandButton2 หรือ 3 ก็ยังได้ค่าเป็น 0

หากไม่ประกาศตัวแปร

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    Dim c As Integer
       'Other code        
End Sub 

ผมสังเกตุเห็นว่า colSelect .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) ได้ค่าเป็น Empty ไม่แสดง colSelect ที่แสดงจำนวน column ใน CommandButton2_Click() หรือ CommandButton3_Click()
หากเราจะเลือก CommandButton2 หรือ 3 ก็ยังได้ค่าเป็น Empty

ผมเข้าใจว่าอย่างไรก็ต้องประกาศตัวแปรครับ

หรือ ผมลองประกาศตัวแปร ใน

Code: Select all

Private Sub UserForm_Initialize()

Dim colSelect As Integer
Dim i As Long
Dim lastlow As Long

 'Other code  

ก็ยังขึ้น Run-time error '1004': Application or object-defined error ครับ

ขอบคุณครับ

add and select copy.xlsm

[logic]

ประกาศตัวแปรไว้บนสุดของ Module เป็น
CODE: SELECT ALL

Dim colSelect As Integer

นี่ครับประกาศไว้บนสุดตามที่อาจารย์บอก

[Totem]

ประกาศตัวแปรไว้บนสุดของ Module เป็น
CODE: SELECT ALL

Dim colSelect As Integer

นี่ครับประกาศไว้บนสุดตามที่อาจารย์บอก

ผมเข้าใจไม่ตรงเองครับ
ได้ตามต้องการครับ ขอบคุณ คุณ logic และอาจารย์ ครับ

[Totem]

เรียนอาจารย์และเพื่อนสมาชิก
ได้ทดลอง code กับไฟล์ตัวอย่าง

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    
    Dim c As Long
    For c = 0 To Me.ListBox2.ListCount - 1

        If Me.ListBox1.Selected(c) = True Then
            With Worksheets("add")
            
                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 1).Value = .Range("i2").Offset(c, 0).Resize(1, 1).Value ' copy 1 column
                
            End With
            Me.ListBox1.Selected(c) = False
        End If
    Next c
End Sub

Resize(1, 1).Value เป็น copy 1 column เลือกรายการใน Listbox 1 หลายรายการก็ copy รายการที่่ต้องการได้ครบถ้วน ใน 1 column ไม่มีปัญหา

แต่ นำไปใช้ code ข้างต้นไปใช้ กับข้อมูลจริง เลือกรายการใน Listbox 1 หลายรายการ กลับ Loop เข้าเงื่อนไข Me.ListBox1.Selected(c) = True แล้ว copy เฉพาะรายการที่เลือกบรรทัดแรกที่เลือกเท่านั้น ส่วนรายการอื่นๆที่เลือกไว้กลับล้างออกหมดไม่ copy ต่อไปจนครบที่เราเลือกไว้
ผมลองตรวจการ loop

Code: Select all

MsgBox.Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 1).Value

Code: Select all

MsgBox.Range("i2").Offset(c, 0).Resize(1, 1).Value

ก็แสดงการ Loop จนครบทุกรายการที่เลือก
แต่พอใช้ code

Code: Select all

.Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                    .Resize(1, 1).Value = .Range("i2").Offset(c, 0).Resize(1, 1).Value ' 

กลับ Loop copy รายการเดียว ที่เหลือล้างที่เรา select ไว้แล้วยัง Loop จนครบทุกรายการ
เมื่อล้าง select ไป Loop ก็ ไม่เข้าเงื่อนไข Me.ListBox1.Selected(c) = True ก็ทำให้ไม่พบ รายการที่เรา select ไว้มากกว่า 1 รายการ ครับ
พบจะมีวิธีแก้ไขไหมครับ


ขอบคุณครับ

[snasui]

กรุณาแนบไฟล์ล่าสุดที่ Update Code นี้เอาไว้แล้ว อธิบายลำดับการทดสอบ ปัญหาที่เกิด แจ้งผลลัพธ์ที่ต้องการ จะได้สะดวกในการทำความเข้าใจครับ

[Totem]

กรุณาแนบไฟล์ล่าสุดที่ Update Code นี้เอาไว้แล้ว อธิบายลำดับการทดสอบ ปัญหาที่เกิด แจ้งผลลัพธ์ที่ต้องการ จะได้สะดวกในการทำความเข้าใจครับ

จาก code ที่ให้มานั้นไม่ปัญหาใช้ได้ครับ
แต่มีการปรับเปลี่ยนรายการข้อมูลภายหลังครับ ผมเจอปัญหาแล้วที่ต้องปรับ code ครับ
ขออธิบายดังนี้

จาก code เดิม

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    
    Dim c As Long
    For c = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox1.Selected(c) = True Then
            With Worksheets("add")
              
                .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                .Resize(1, 1).Value = .Range("i2").Offset(c, 0).Resize(1, 1).Value ' copy 1 column
                
            End With
            Me.ListBox1.Selected(c) = False
        End If
    Next c
End Sub

Code: Select all

Private Sub CommandButton1_Click()

Dim i As Long
Dim lastlow As Long
    
    
    ListBox1.MultiSelect = 1
    ListBox2.MultiSelect = 1
    
    lastlow = Sheets("add").Range("I" & Rows.Count).End(xlUp).Row
    
        ListBox1.ColumnCount = 3
        ListBox1.RowSource = Sheets("add").Range(Cells(2, 9), Cells(lastlow, 11)).Address
End Sub

Code: Select all

        ListBox1.ColumnCount = 3
        ListBox1.RowSource = Sheets("add").Range(Cells(2, 9), Cells(lastlow,

ปรับเป็น 3 column แสดงรายการได้ตามปกติ

ปัญหาจาก column K ชื่อ remark ใน column K เป็นสูตร ครับ

เมื่อเรา เลือกรายการใน Listbox 1 หลายรายการ กลับ Loop เข้าเงื่อนไข Me.ListBox1.Selected(c) = True แล้ว copy เฉพาะรายการที่เลือกบรรทัดแรกที่เลือกเท่านั้น ส่วนรายการอื่นๆที่เลือกไว้กลับล้างออกหมดไม่ copy ต่อไปจนครบที่เราเลือกไว้
เพราะ มีการ refresh และ calculate สูตรใหม่ใน column K ทุกครั้ง
ทำให้ รายการใน Listbox 1 ทำการ refresh รายการที่เลือกไว้ทั้งหมดออกไป
ดังนี้ จาก code

Code: Select all

              .Cells(.Rows.Count, colSelect).End(xlUp).Offset(1, 0) _
                .Resize(1, 1).Value = .Range("i2").Offset(c, 0).Resize(1, 1).Value ' 

จะมีวิธีแก้ไขไหมครับ

ขอบคุณครับ

add and select.xlsm

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    Dim c As Long
    Application.Calculation = xlCalculationManual
    'Other code
    Application.Calculation = xlCalculationAutomatic
End Sub

[Totem]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub CommandButton4_Click() ' SAVE
    Dim c As Long
    Application.Calculation = xlCalculationManual
    'Other code
    Application.Calculation = xlCalculationAutomatic
End Sub

ผมมองข้ามไปได้อย่างไร ขอบคุณครับ ได้ตามต้องการครับ

[Totem]

เรียนอาจารย์ครับ
ผมนำ code ที่อาจารย์ให้มาในการ delete รายการ นำมาปรับใช้ ใน Listbox2
ปุ่ม Private Sub CommandButton5_Click()
หลักการคือ
1.เลือกชื่อ แผนก 1 หรือ ชื่อ แผนก 2 ตามความต้องการมาแสดงไว้ใน Listbox2
2.จากนั้นเลือก ใน ListBox2.MultiSelect เลือกได้หลายรายการในคราวเดียวกัน
3.เมื่อเลือกรายการที่ต้องการ delete จะเป็น 1 รายการหรือมากกว่า 1 รายการ ได้แล้ว
จึงทำการกดปุ่ม Private Sub CommandButton5_Click()
เพื่อ delete รายการนั้นๆและเลื่อนรายการที่ไม้ได้ delete เลื่อนขึ้นไปติดกันไม่ให้เป็นช่องว่างใน column นั้นๆ
4.เมื่อ Loop แล้ว มีปัญหาใน code

Code: Select all

Cells(i, colSelect).Resize(UBound(temp, 1), colSelect).Value = temp

run time error 13 type mismatch

ผมลองประกาศตัวแปร ให้อยู่ใน type เดียวกัน ก็ยังไม่ได้ครับ
เช่น Dim temp , i , c As Variant เป็นต้น

อาจารย์ช่วยปรับ code ด้วยครับ

Code: Select all

Private Sub CommandButton5_Click()

    Dim i , c As Integer
    Dim lastrow As Long
    Dim temp As Variant
    
    Application.Calculation = xlCalculationManual
    
     lastrow = Me.ListBox2.ListCount
        
    If MsgBox("Are you sure you want to delete the row?", vbYesNo + vbQuestion, "Delete row") = vbYes Then

    For c = 0 To Me.ListBox2.ListCount - 1
                If Me.ListBox2.Selected(c) = True Then
                    For i = 1 To lastrow
                        If Cells(i, 2) = ListBox2.List(ListBox2.ListIndex) Then
                            If Cells(i + 1, 2).Value <> "" Then
                                temp = Range(Cells(i + 1, colSelect), Cells(Rows.Count, colSelect).End(xlUp)).Resize(, 1)
                                Range(Cells(i, colSelect), Cells(Rows.Count, colSelect).End(xlUp)).ClearContents
                                Cells(i, colSelect).Resize(UBound(temp, 1), colSelect).Value = temp
                            Else
                                Range(Cells(i, colSelect), Cells(Rows.Count, colSelect).End(xlUp)).ClearContents
                            End If
                            Exit For
                        End If
                    Next i
                        Me.ListBox2.Selected(c) = False
                End If
            Next c
    End If
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub

ขอบคุณครับ

add and select.xlsm

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub CommandButton5_Click() ' delete

    Dim c As Integer, i As Integer
    Dim lastrow As Long
    Dim temp(0 To 99, 1) As Variant, j As Integer
    
    Application.Calculation = xlCalculationManual
    
    lastrow = Cells(Rows.Count, colSelect).End(xlUp).Row
        
    If MsgBox("Are you sure you want to delete the row?", vbYesNo + vbQuestion, "Delete row") = vbYes Then

        For c = 0 To Me.ListBox2.ListCount - 1
            i = 0
            If Me.ListBox2.Selected(c) = True Then
                For i = 2 To lastrow
                    If Cells(i, colSelect).Value = ListBox2.List(c) Then
                        Cells(i, colSelect).Resize(, 2).ClearContents
                        Exit For
                    End If
                Next i
                Me.ListBox2.Selected(c) = False
            End If
        Next c
        For i = 2 To lastrow
            If Cells(i, colSelect).Value <> "" Then
                temp(j, 0) = Cells(i, colSelect).Value
                temp(j, 1) = Cells(i, colSelect + 1).Value
                j = j + 1
            End If
        Next i
    End If
    If j > 0 Then
        Range(Cells(2, colSelect), Cells(lastrow, colSelect + 1)).ClearContents
        Cells(2, colSelect).Resize(j, 2).Value = temp
    End If
    Application.Calculation = xlCalculationAutomatic
    
End Sub

[Totem]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub CommandButton5_Click() ' delete

    Dim c As Integer, i As Integer
    Dim lastrow As Long
    Dim temp(0 To 99, 1) As Variant, j As Integer
    
    Application.Calculation = xlCalculationManual
    
    lastrow = Cells(Rows.Count, colSelect).End(xlUp).Row
        
    If MsgBox("Are you sure you want to delete the row?", vbYesNo + vbQuestion, "Delete row") = vbYes Then

        For c = 0 To Me.ListBox2.ListCount - 1
            i = 0
            If Me.ListBox2.Selected(c) = True Then
                For i = 2 To lastrow
                    If Cells(i, colSelect).Value = ListBox2.List(c) Then
                        Cells(i, colSelect).Resize(, 2).ClearContents
                        Exit For
                    End If
                Next i
                Me.ListBox2.Selected(c) = False
            End If
        Next c
        For i = 2 To lastrow
            If Cells(i, colSelect).Value <> "" Then
                temp(j, 0) = Cells(i, colSelect).Value
                temp(j, 1) = Cells(i, colSelect + 1).Value
                j = j + 1
            End If
        Next i
    End If
    If j > 0 Then
        Range(Cells(2, colSelect), Cells(lastrow, colSelect + 1)).ClearContents
        Cells(2, colSelect).Resize(j, 2).Value = temp
    End If
    Application.Calculation = xlCalculationAutomatic
    
End Sub

เรียนอาจารย์ได้ตามต้องการครับ

ถามเพิ่มเติมครับ การประกาศตัวแปร

Dim temp(0 To 99, 1)

ที่ 0 to 99 คือ จำนวนแถวหรือเปล่าครับ เราสามารถกำหนดได้เพิ่มได้มากตามความต้องการตามข้อมูลที่จะใช้ ใช่ไหมครับ
และ จำนวน Dim(...,1) คือจำนวนคอลัมน์ใช่หรือเปล่าครับ

ขอบคุณครับ

[snasui]

Dim temp(0 To 99, 1)

ที่ 0 to 99 คือ จำนวนแถวหรือเปล่าครับ

ใช่ครับ

เราสามารถกำหนดได้เพิ่มได้มากตามความต้องการตามข้อมูลที่จะใช้ ใช่ไหมครับ

ใช่ครับ และควรลองด้วยตัวเอง ค่านั้นอยู่ในตัวแปรแบบ Array ที่ประกาศให้นำหน้าด้วย Dim โดยทั่วไปตัวแปรแบบ Array ย่อมต้องเปลี่ยนแปลงขนาดได้หรือเขียนให้เผื่อไว้จนเพียงพอที่จะรับข้อมูลที่มีการเปลี่ยนแปลงเพิ่มลด เพราะมีหลายโอกาสที่ต้องเขียนให้รองรับปริมาณข้อมูลที่ไม่แน่นอนครับ

ตัวแปรที่ไม่สามารถเปลี่ยนค่าได้คือที่ประกาศนำหน้าด้วย CONST ครับ

จำนวน Dim(...,1) คือจำนวนคอลัมน์ใช่หรือเปล่าครับ

ใช่ครับ

[Totem]

ขอบคุณครับ