ทำข้อมูลให้วางต่อเนื่องในตาราง Excel

[yooyoyui]

Code: Select all

i = 1
    For i = 1 To no_c
            If c_text(i) = "1" Then
             Workbooks("Sample Excel File Data_test.xlsx").Worksheets("CMM (1)").Range("h12").Offset(0, i).Value = data(i)
            End If
    Next i
  
    i = 1
    For i = 1 To no_c
            If c_text(i) = "2" Then
             Workbooks("Sample Excel File Data_test.xlsx").Worksheets("CMM (1)").Range("h13").Offset(0, i).Value = data(i)
            End If
    Next i

4.png

ไฟล์ที่ดึงข้อมูลมา.xlsx

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

และถ้าเราจะวนลูปให้มันหาค่า จากตัวเลข 1 - 100 จะสามารถทำได้ไหมค่ะ

ขอบคุณค่ะ

[snasui]

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

[yooyoyui]

data_report.xlsm

ตัวอย่างข้อมูลที่จะดึง ซึ่งในการดึงข้อมูลจะแบ่งข้อมูลเป็นชุดข้อมูลในตัวอย่างจะมี 4 ชุดข้อมูล ซึ่งแต่ละชุดข้อมูลจะนำไปใส่ในตารางแบ่งเป็นคอลัมน์ 1,2,3 จนถึง 10

การดึงค่าจะหาค่าตัวเลขจากคอลัมน์ a แล้วจะนำข้อมูลที่ตรงกันในคอลัมน์ c ไปใส่ในตาราง report ให้ตรงตามข้อ ค่าที่ 1 ของชุดที่ 1 จะอยู่ในคอลัมน์ 1 แถวที่ 1

ค่าที่ 1 ของชุดที่ 2 จะอยู่ในคอลัมน์ 2 แถวที่ 1 , ค่าที่ 1 ของชุดที่ 3 จะอยู่ในคอลัมน์ 3 แถวที่ 1 เรียงไปแบบนี้จนครบ 10 ชุดข้อมูลค่ะ

[snasui]

ตัวอย่าง Code ตามด้านล่าง อย่าลืมล้างข้อมูลเดิมและข้อมูลตั้งแต่คอลัมน์ T เป็นต้นไปทิ้งไปก่อนที่จะ Run Code ครับ

Code: Select all

Sub test()
    Dim rAll As Range
    Dim r As Range
    Dim rt As Range
    Set rAll = Sheets("data").Range("a1:a580")
    For Each r In rAll
        If r.Value <= 10 Then
            With Sheets("data_report")
                Set rt = .Range("h12")
            End With
            If rt.Offset(r.Value - 1, 0) = "" Then
                rt.Offset(r.Value - 1, 0) = r.Offset(0, 2).Value
            Else
                rt.Offset(r.Value - 1, 1000).End(xlToLeft) _
                    .Offset(0, 1) = r.Offset(0, 2)
            End If
        End If
    Next r
End Sub

[yooyoyui]

แล้วถ้าจะเขียนต่อโดยให้นำ ค่าที่ 28 ถึง 70 ไว้ใน ชีทที่ 2 และ จาก 71- 100 ไว้ในชีทที่ 3 ต้องเพิ่มตรงไหนค่ะ

[snasui]

ลองปรับมาเองก่อนตามกฎข้อ 5 ด้านบนครับ ติดตรงไหนค่อยถามกันต่อครับ

[yooyoyui]

อยากจะให้อธิบายความหมายของโค้ดแต่ละบรรทัด ให้หน่อยได้ไหมค่ะ พอดีไม่ทราบจริงๆค่ะ

ขอบคุณค่ะ

Code: Select all

            If rt.Offset(r.Value - 1, 0) = "" Then
                rt.Offset(r.Value - 1, 0) = r.Offset(0, 2).Value
            Else
                rt.Offset(r.Value - 1, 1000).End(xlToLeft) _
                    .Offset(0, 1) = r.Offset(0, 2)

[snasui]

อธิบายหลัก ๆ นะครับ

r.offset(x,y) หมายถึงจากค่า r ให้ลงไปด้านล่าง x บรรทัด และไปทางขวา y คอลัมน์

x และ y สามารถเป็นลบและ 0 ได้ หาก Code เป็น r.offset(0,0) แสดงว่าอยู่ที่เดิม

r.end(xltoleft) หมายถึงว่าจากตำแหน่งค่า r ให้เลื่อนไปทางซ้ายจนกว่าจะพบเซลล์ที่มีข้อมูล

[yooyoyui]

If r.Value <= 27 Then
With Sheets("CMM (2)")
Set rt = .Range("h3")
End With
If rt.Offset(r.Value - 1, 0) = "" Then
rt.Offset(r.Value - 1, 0) = r.Offset(0, 2).Value
Else
rt.Offset(r.Value - 1, 1000).End(xlToLeft) _
.Offset(0, 1) = r.Offset(0, 2)
End If

พอเปลี่ยน r.Value <= 27 เป็น r.Value >= 28 ทำไมถึงติด debug. ที่่ rt.Offset(r.Value - 1, 0) ค่ะ มันสัมพันธ์กันยังไงค่ะ
พอดีไม่ค่อยมีพื้นฐานเรื่องนี้เท่าไรนักค่ะ ต้องขอโทษด้วยนะค่ะ ไม่เข้าใจจริงๆ
ขอบคุณค่ะ

[snasui]

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

[yooyoyui]

report.1.xlsm

ต้องการให้ข้อมูลที่หาได้จากตัวเลข 1 - 27 ใส่ไว้ใน sheet1 = CMM (1)

และข้อมูลที่หาได้จากตัวเลข 28 - 70 ใส่ไว้ใน sheet2 = CMM (2)

และข้อมูลที่หาได้จากตัวเลข 71 - 100 ใส่ไว้ใน sheet3 = CMM (3)

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub test0()
    Dim rAll As Range
    Dim r As Range
    Dim rt As Range
    Set rAll = Sheets("data").Range("a1:a580")
    For Each r In rAll
        If r.Value >= 1 And r.Value <= 100 Then
            Select Case r.Value
                Case 1 To 27
                    Set rt = Sheets("CMM (1)").Range("h12").Offset(r.Value - 1, 0)
                Case 28 To 70
                    Set rt = Sheets("CMM (2)").Range("h3").Offset(r.Value - 28, 0)
                Case 71 To 100
                    Set rt = Sheets("CMM (3)").Range("h3").Offset(r.Value - 71, 0)
            End Select
            If rt = "" Then
                rt = r.Offset(0, 2).Value
            Else
                rt.Offset(0, 1000).End(xlToLeft).Offset(0, 1) = r.Offset(0, 2)
            End If
        End If
    Next r
End Sub