copy ข้อมูลข้ามชีทด้วย VBA

[pro602]

ช่วยแนะนำการปรับ Code การ Copy ข้อมูลจาก Sheet Rawdata ไปวางที่ Sheet Form ให้ผมหน่อยครับ
-ต้องการ Copy ข้อมูลจาก Rawdata ไปวางที่ Form ให้ตรงตามวันที่ โดยที่ Formจะเป็นการวางข้อมูลข้ามไปที่ล่ะ 1 Column
ปัญหาที่ผมพบในการเขียน Code คือในตอนนี้สามารถ Copyได้แค่ Step แรกพอจะมา Copy ข้อมูลวันที่ถัดไปจาก Sheet Form ไม่ได้ครับ
ช่วยแนะนำการปรับ Code ให้ผมหน่อยครับ (ผมก็คิดว่าน่าจะผิดตรงการกำหนด For กับ Nextj,Next l ผมกำลังฝึกเขียน VBA จาก Code ที่ทำมามีจุดไหนไม่ถูกหลักการเขียนช่วยแนะนำหลักการให้ผมด้วยครับ)

Code: Select all

Option Explicit
Sub Copy_range()
Dim Sht As Worksheet, Sht1 As Worksheet
Dim lrow As Long, lrow1 As Long
Dim cLumn As Long, cLumn1 As Long
Dim i As Long, j As Long, l As Long
  Set Sht = ThisWorkbook.Worksheets("RawData")
  Set Sht1 = ThisWorkbook.Worksheets("Form")
  Sht.Activate
        lrow1 = Cells(Rows.Count, "A").End(xlUp).Row
        cLumn1 = Cells(2, Columns.Count).End(xlToLeft).Column
         For l = 1 To cLumn1
        Sht.Select
        Range(Cells(2, l), Cells(lrow1, l)).Copy
        Selection.SpecialCells(xlCellTypeVisible).Select
       Sht1.Select
      cLumn = Cells(1, Columns.Count).End(xlToLeft).Column
  For j = 1 To cLumn Step 2
  Sht1.Select
        Cells(2, j).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Next j
        Next l
End Sub

[snasui]

ในชีต Rawdata คอลัมน์ A, B เป็นวันที่เดียวกันจะวางในชีต Form อย่างไรกรุณาอธิบายมาด้วยครับ

สมมุติว่า คอลัมน์ A และ B เป็นคนละวันที่ สามารถปรับ Code เป็นด้านล่างครับ

Code: Select all

Sub Copy_range()
    Dim rSource As Range, rTarget As Range
    Dim x As Integer
    With Worksheets("Rawdata")
        Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    Do While rSource.Range("a1").Value <> ""
        With Worksheets("Form")
            Set rTarget = .Range(rSource.Address).Offset(0, x)
        End With
        rSource.Copy rTarget
        x = x + 1
        Set rSource = rSource.Offset(0, 1)
    Loop
End Sub

[pro602]

ในชีต Rawdata คอลัมน์ A, B เป็นวันที่เดียวกันจะวางในชีต Form อย่างไรกรุณาอธิบายมาด้วยครับ

สมมุติว่า คอลัมน์ A และ B เป็นคนละวันที่ สามารถปรับ Code เป็นด้านล่างครับ

Code: Select all

Sub Copy_range()
    Dim rSource As Range, rTarget As Range
    Dim x As Integer
    With Worksheets("Rawdata")
        Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    Do While rSource.Range("a1").Value <> ""
        With Worksheets("Form")
            Set rTarget = .Range(rSource.Address).Offset(0, x)
        End With
        rSource.Copy rTarget
        x = x + 1
        Set rSource = rSource.Offset(0, 1)
    Loop
End Sub

ผลลัพธ์เป็นไปตามที่ต้องการเลยครับอาจารย์ ส่วนวันที่ผมป้อนข้อมูลไปผิดครับมันต้องเป็นคนล่ะวันไปตามลำดับ ผมรบกวนอาจารย์ช่วยอธิบาย Code 5 จุดนี้ให้ผมได้เข้าใจพอเป็นหลักการในการนำไปใช้งานในงานต่อๆไปหน่อยครับ (Codeของผมเขียนไปในรูปแบบนั้นนำมาใช้กับผลลัพธ์รูปแบบนี้ไม่ได้ใช่ไหมครับอาจารย์)

Code: Select all

With Worksheets("Rawdata")
        Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))  จุุดที่1...  .Range มีจุด . ข้างหน้า Range หมายถึงอะไรและต้องมีในกรณีไหนครับ
    End With
    Do While rSource.Range("a1").Value <> ""  จุดที่2...เงื่อนไขตรงนี้ผมงงครับ เห็นมี a1 เข้าด้วยยิ่งงงเลย
       
        With Worksheets("Form")
            Set rTarget = .Range(rSource.Address).Offset(0, x)  จุดที่3...
        End With
        rSource.Copy rTarget
        x = x + 1    จุดที่4...
        Set rSource = rSource.Offset(0, 1) จุดที่5...Set rSource  ชุดนี้ต่างกับ Set ครั้งแรกหมายถึงอะไรครับ
    Loop
    

ขอบคุณครับ

[snasui]

With Worksheets("Rawdata")
Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp)) จุุดที่1... .Range มีจุด . ข้างหน้า Range หมายถึงอะไรและต้องมีในกรณีไหนครับ

สังเกตว่ามี With Worksheets("Rawdata") อยู่บรรทัดบน ดังนั้น Statement ภายใน with สามารถเขียนย่อคือมีแค่ . นำหน้าได้ มีความหมายเดียวกันกับการเขียนแบบเต็ม ๆ คือ Set rSource = Worksheets("Rawdata").Range("a2", Worksheets("Rawdata").Range("a" & Worksheets("Rawdata").Rows.Count).End(xlUp)) ครับ

Do While rSource.Range("a1").Value <> "" จุดที่2...เงื่อนไขตรงนี้ผมงงครับ เห็นมี a1 เข้าด้วยยิ่งงงเลย

ตัวแปร rSource เริ่มจาก A2:AN (N คือค่าสุดท้ายในคอลัมน์ A) การเขียนว่า rSource.Range("a1") คือให้นำเซลล์แรกในช่วง A2:AN มาใช้ สำหรับ Statement นี้เป็นการนำมาเช็คว่าเป็นค่าว่างใช่หรือไม่

Set rTarget = .Range(rSource.Address).Offset(0, x) จุดที่3...

เป็นการกำหนดค่าให้ขยับ rTarget ขยับไปทางด้านขวาเท่ากับตัวแปร x ถ้า x เป็น 5 ก็แปลว่าขยับไปทางขวา 5 คอลัมน์ เช่นนี้ครับ

x = x + 1 จุดที่4...

เป็นการเพิ่มค่าให้ตัวแปร x ไปครั้งละ 1 ครับ

Set rSource = rSource.Offset(0, 1)

เป็นการกำหนดค่าให้ตัวแปร rSource ขยับไปด้านขวาครั้งละ 1 คอลัมน์ครับ

[pro602]

With Worksheets("Rawdata")
Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp)) จุุดที่1... .Range มีจุด . ข้างหน้า Range หมายถึงอะไรและต้องมีในกรณีไหนครับ

สังเกตว่ามี With Worksheets("Rawdata") อยู่บรรทัดบน ดังนั้น Statement ภายใน with สามารถเขียนย่อคือมีแค่ . นำหน้าได้ มีความหมายเดียวกันกับการเขียนแบบเต็ม ๆ คือ Set rSource = Worksheets("Rawdata").Range("a2", Worksheets("Rawdata").Range("a" & Worksheets("Rawdata").Rows.Count).End(xlUp)) ครับ

Do While rSource.Range("a1").Value <> "" จุดที่2...เงื่อนไขตรงนี้ผมงงครับ เห็นมี a1 เข้าด้วยยิ่งงงเลย

ตัวแปร rSource เริ่มจาก A2:AN (N คือค่าสุดท้ายในคอลัมน์ A) การเขียนว่า rSource.Range("a1") คือให้นำเซลล์แรกในช่วง A2:AN มาใช้ สำหรับ Statement นี้เป็นการนำมาเช็คว่าเป็นค่าว่างใช่หรือไม่

Set rTarget = .Range(rSource.Address).Offset(0, x) จุดที่3...

เป็นการกำหนดค่าให้ขยับ rTarget ขยับไปทางด้านขวาเท่ากับตัวแปร x ถ้า x เป็น 5 ก็แปลว่าขยับไปทางขวา 5 คอลัมน์ เช่นนี้ครับ

x = x + 1 จุดที่4...

เป็นการเพิ่มค่าให้ตัวแปร x ไปครั้งละ 1 ครับ

Set rSource = rSource.Offset(0, 1)

เป็นการกำหนดค่าให้ตัวแปร rSource ขยับไปด้านขวาครั้งละ 1 คอลัมน์ครับ

ขอบคุณครับอาจารย์

[pro602]

ในชีต Rawdata คอลัมน์ A, B เป็นวันที่เดียวกันจะวางในชีต Form อย่างไรกรุณาอธิบายมาด้วยครับ

สมมุติว่า คอลัมน์ A และ B เป็นคนละวันที่ สามารถปรับ Code เป็นด้านล่างครับ

Code: Select all

Sub Copy_range()
    Dim rSource As Range, rTarget As Range
    Dim x As Integer
    With Worksheets("Rawdata")
        Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    Do While rSource.Range("a1").Value <> ""
        With Worksheets("Form")
            Set rTarget = .Range(rSource.Address).Offset(0, x)
        End With
        rSource.Copy rTarget
        x = x + 1
        Set rSource = rSource.Offset(0, 1)
    Loop
End Sub

code ด้านบน ถ้าข้อมูลต้นทางเป็น Table และมีการ Filter ข้อมูล ต้องการ Copy ไปเฉพาะช่วงข้อมูลที่แสดงต้องปรับ Code ตรงจุดไหนครับ
หลังจากที่นำไปใช้กับข้อมูลที่เป็น Table และ Filter พบว่าช่วงข้อมุลที่ซ่อนไว้ก็ยังถุก Copy ไปด้วยครับ

[snasui]

กติกาคือต้องปรับมาเองก่อนครับ

สำหรับการหาเฉพาะค่าที่มองเห็น ไม่รวมค่าที่ซ่อนสามารถใช้คำค้นเป็น select visible only หรือข้อความอื่นใดที่คล้ายกันนี้ได้ครับ

[pro602]

กติกาคือต้องปรับมาเองก่อนครับ

สำหรับการหาเฉพาะค่าที่มองเห็น ไม่รวมค่าที่ซ่อนสามารถใช้คำค้นเป็น select visible only หรือข้อความอื่นใดที่คล้ายกันนี้ได้ครับ

-ขอบคุณครับอาจารย์ ผมลองปรับ Code ออกมาได้แบบนี้ครับ ผลที่ได้ก็ได้ตามที่ต้องการครับอาจารย์ฃ่วยแนะนำการปรับ Code ให้ผมหน่อยครับตอนเอาข้อมูลไปวางให้วางเฉพาะ Value ตอนนี้พอไปวางมันเอา Format ไปด้วยครับ

Code: Select all

Sub Copy_range1()
    Dim rSource As Range, rTarget As Range
    Dim x As Integer
    With Worksheets("Rawdata")
        Set rSource = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    Do While rSource.Range("a1").Value <> ""
        With Worksheets("Form")
            Set rTarget = .Range(rSource.Address).Offset(0, x)
        End With
         Worksheets("Rawdata").Select
         Range(rSource.Address).Select
         Selection.SpecialCells(xlCellTypeVisible).Select
         Selection.Copy rTarget
         x = x + 1
        Set rSource = rSource.Offset(0, 1)
    Loop
End Sub

[snasui]

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

Code: Select all

'Other code
Do While rSource.Range("a1").Value <> ""
    With Worksheets("Form")
        Set rTarget = .Range(rSource.Address).Offset(0, x)
    End With
    rSource.SpecialCells(xlCellTypeVisible).Copy
    rTarget.PasteSpecial xlPasteValues
    x = x + 1
    Set rSource = rSource.Offset(0, 1)
    Application.CutCopyMode = False
Loop

'Other code

[pro602]

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

Code: Select all

'Other code
Do While rSource.Range("a1").Value <> ""
    With Worksheets("Form")
        Set rTarget = .Range(rSource.Address).Offset(0, x)
    End With
    rSource.SpecialCells(xlCellTypeVisible).Copy
    rTarget.PasteSpecial xlPasteValues
    x = x + 1
    Set rSource = rSource.Offset(0, 1)
    Application.CutCopyMode = False
Loop

'Other code

-ขอบคุณครับอาจารย์ ได้ตรงตามที่ต้องการทุกประการพร้อมกับ Code แบบสั้นกระทัดรัด (codeที่ผมเขียนก็ศึกษาและนำมาจากเว็ปต่างๆมาประยุกต์ผสมผสนกันใช้งานตามที่เข้าใจ ขอบคุณอาจารย์อีกครั้งครับที่ให้คำแนะนำและเทคนิคการปรับใช้ Code)