กำหนดVba Copy ข้อมูลต่อลงแถวไปเรื่อยๆยังไงครับ

[chinnapong]

Code: Select all

Sub test()
    Columns("A:E").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

อยากทราบกำหนดค่ายังไงครับ เมื่อมีข้อมูลใหม่ทั้งหมดของ Sheet1 แล้วจาก Sheet1 Copy ไปยัง Sheet2 ที่มีข้อมูลอยู่แล้วนั้นให้ต่อแถวลงมาข้างล้างครับเรื่อยๆครับ และเมื่อSheet2 มีข้อมูลให้นับ หัวข้อ No ให้ + เป็นตัวเลขเรียงกันไปเรื่อยด้วยครับ

ขอบคุณล่วงหน้าครับ

[snasui]

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

Code: Select all

'Other code
Dim rngAll As Range
Dim j As Long, r As Range
Dim i As Integer, k As Integer
With Sheets("Sheet1")
    Set rngAll = .Range("e2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    With .Range("a" & .Rows.Count).End(xlUp)
        .Offset(1, 1).Resize(i, 5).Value = rngAll.Value
        For k = 1 To i
           .Offset(k, 0).Value = k + j
        Next k
    End With
End With
'Other code

[chinnapong]

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

Code: Select all

'Other code
Dim rngAll As Range
Dim j As Long, r As Range
Dim i As Integer, k As Integer
With Sheets("Sheet1")
    Set rngAll = .Range("e2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    With .Range("a" & .Rows.Count).End(xlUp)
        .Offset(1, 1).Resize(i, 5).Value = rngAll.Value
        For k = 1 To i
           .Offset(k, 0).Value = k + j
        Next k
    End With
End With
'Other code

ขอบคุณครับผมแต่ผมเจอปัญหาคือเมื่อ Sheet1 มีค่าว่าง มันเอาหัวตารางมาด้วย ถ้าจะไม่เอาหัวตารางของ Sheet1 มาด้วยทำยังไงครับ รูปแนบครับ

[snasui]

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

[chinnapong]

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

ผมลองปรับแล้วครับอาจารย์ ปัญหาไม่ยอมต่อลงบรรทัดสุดท้ายครับ กับไม่รันนัมเบอร์ครับ กับไม่เอาค่าจากชีท 1 ที่ซ้ำกันมารวมกันกับชีท2ด้วยครับ
ผมเองไม่เก่ง VBA ยังไม่ค่อยเข้าใจครับรบกวนด้วยครับ
ขอบคุณครับ
ตัวอย่าง code

Code: Select all

Sub test()
Dim rngAll As Range
Dim j As Long, r As Range
Dim i As Integer, k As Integer
With Sheets("Sheet1")
    Range("A2:J2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Set rngAll = .Range("j2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
With Sheets("Sheet2")
    Sheets("Sheet2").Select
    Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    With .Range("a" & .Rows.Count).End(xlUp)
        .Offset(1, 1).Resize(i, 11).Value = rngAll.Value
        For k = 1 To i
           .Offset(k, 0).Value = k + j
        Next k
    End With
    Sheets("Sheet1").Select
End With
End Sub

[snasui]

ลองปรับแล้วครับอาจารย์ ปัญหาไม่ยอมต่อลงบรรทัดสุดท้ายครับ

ลบข้อมูลใน Sheet2 ทิ้งให้หมดก่อน เหลือไว้เฉพาะหัวคอลัมน์ครับ

สำหรับการปรับ Code เมื่อ Sheet1 ไม่มี Data คือตามด้านล่าง เมื่อลบข้อมูลตามวรรคก่อนแล้วแก้ไข Code ตามด้านล่างแล้วให้ทดสอบดูใหม่ครับ

Code: Select all

'Other code
With Sheets("Sheet1")
    If .Range("a2").Value = "" Then Exit Sub
    Set rngAll = .Range("j2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
'Other code

ไม่เอาค่าจากชีท 1 ที่ซ้ำกันมารวมกันกับชีท2ด้วยครับ

รวมคอลัมน์ไหนบ้าง เขียนไว้แล้วหรือไม่ ถ้ายังไม่เขียนให้เขียนมาเองก่อน ได้เท่าไรก็เท่านั้นแต่จะต้องสอดคล้องกับคำถามครับ

[chinnapong]

รวมคอลัมน์ไหนบ้าง เขียนไว้แล้วหรือไม่ ถ้ายังไม่เขียนให้เขียนมาเองก่อน ได้เท่าไรก็เท่านั้นแต่จะต้องสอดคล้องกับคำถามครับ

อ้างอิงจากเมื่อ Sheet1 Column D ตั้งแต่แถวที่ 2 ลงไป ถ้า Sheet2 Column E แถวที่ 2ลงไปมีข้อมูลของ Sheet1 Column D อยู่แล้วให้เอาค่าต่อไปของ Sheet1 Column D ที่ไม่ซ้ำกันเอาข้อมูลมาใส่ Sheet2
ขอแนวทาง Code ตัวอย่างพอจับเดาทางด้วยครับ
ขอบคุณครับ

[snasui]

กรณีนี้ต้องแก้ไข Code เดิมแทบทั้งหมดเพราะเป็นการ Loop เช็คไปทีละบรรทัด ซึ่งตัวอย่างที่ผมเขียนให้ไปนั้นเป็นการนำข้อมูลใน Sheet1 ไปวางใน Sheet2 พร้อมกันทีเดียวทุกบรรทัด โดยไม่สนใจว่ามีค่าซ้ำหรือไม่ ทั้งนี้เนื่องจากไม่ได้แจ้งมาด้วยว่าหากมีรายการนั้นใน Sheet2 แล้วจะไม่นำรายการนั้นไปวางต่อท้ายข้อมูลใน Sheet2 อีก

Code ด้านล่างนี้เป็นตัวอย่างการ Loop ข้อมูลไปวางแบบเช็ครายบรรทัด หากยังไม่มีรายการนั้นใน Sheet2 ให้นำไปวางต่อท้ายข้อมูลเดิมและให้ลำดับที่ข้อมูลด้วย

Code: Select all

Dim rngAll As Range
Dim j As Long, r As Range
Dim k As Integer
With Sheets("Sheet1")
    If .Range("a2").Value = "" Then Exit Sub
    Set rngAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    For Each r In rngAll
        If Application.CountIf(.Range("e:e"), r.Offset(0, 3).Value) = 0 Then
            j = j + 1
            With .Range("a" & .Rows.Count).End(xlUp)
                .Offset(1, 1).Resize(1, 10).Value = r.Resize(1, 10).Value
                .Offset(1, 0).Value = j
            End With
        End If
    Next r
End With

[chinnapong]

กรณีนี้ต้องแก้ไข Code เดิมแทบทั้งหมดเพราะเป็นการ Loop เช็คไปทีละบรรทัด ซึ่งตัวอย่างที่ผมเขียนให้ไปนั้นเป็นการนำข้อมูลใน Sheet1 ไปวางใน Sheet2 พร้อมกันทีเดียวทุกบรรทัด โดยไม่สนใจว่ามีค่าซ้ำหรือไม่ ทั้งนี้เนื่องจากไม่ได้แจ้งมาด้วยว่าหากมีรายการนั้นใน Sheet2 แล้วจะไม่นำรายการนั้นไปวางต่อท้ายข้อมูลใน Sheet2 อีก

Code ด้านล่างนี้เป็นตัวอย่างการ Loop ข้อมูลไปวางแบบเช็ครายบรรทัด หากยังไม่มีรายการนั้นใน Sheet2 ให้นำไปวางต่อท้ายข้อมูลเดิมและให้ลำดับที่ข้อมูลด้วย

Code: Select all

Dim rngAll As Range
Dim j As Long, r As Range
Dim k As Integer
With Sheets("Sheet1")
    If .Range("a2").Value = "" Then Exit Sub
    Set rngAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    For Each r In rngAll
        If Application.CountIf(.Range("e:e"), r.Offset(0, 3).Value) = 0 Then
            j = j + 1
            With .Range("a" & .Rows.Count).End(xlUp)
                .Offset(1, 1).Resize(1, 10).Value = r.Resize(1, 10).Value
                .Offset(1, 0).Value = j
            End With
        End If
    Next r
End With

ขอบคุณครับอาจารย์ พอจะมีการอธิบายการทำงานของ code แต่ละบรรทัดได้ไหมครับ หรือแหล่งความรู้เริ่มต้นเบสิกเขียน VBA

[snasui]

ลองค่อย ๆ ศึกษาตาม Link นี้ viewtopic.php?f=9&t=411

เริ่มที่หัวข้อ 208 เป็นต้นไปเฉพาะที่เกี่ยวข้องกับ VBA ครับ