ดึงข้อมูล

[Arm_anucha]

ขอรบกวนช่วยปรับ Code ให้หน่อยครับ
ความต้องการคือ อยากให้ Code ที่เป็น offset 0,xx เหลือแค่บรรทัดเดียวครับ
แบบว่าจากเดิมที่ต้องพิมพ์แต่ละตำแหน่งลงใน offset 0,xx
จะลดให้เหลือบรรทัดเดียวแบบที่เป็น จุดเริ่มต้น Cell ไปจนถึงจุดสิ้นสุดที่กำหนดไว้
จากของเดิมอย่างเช่นมี 8 Cell ที่จะดึงข้อมูลมาก็ต้องตรง r.offset ก็ต้องมี 8 บรรทัด
คือลองทำเป็น r.End(xlToRight).Value แต่ไม่ได้ ส่วนที่จะให้แสดงก็เว้น 1 คอลัมน์จากจุดที่กำหนด cell ที่จะดึงมาครับ
เหตุผลที่ต้องทำแบบนี้เพราะที่จะดึงข้อมูลมามีเป็น 30-40 จุดเลยครับ
ต้องขออภัยด้วยครับที่อธิบายไม่ค่อยเข้าใจ ไม่รู้จะอธิบายเป็นคำพูดยังไงครับ รบกวนด้วยครับ

Code: Select all

Sub Test0()
    Dim rAll As Range
    Dim r As Range, strSource As String
    Application.ScreenUpdating = False
    With ActiveSheet
        Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For Each r In rAll
            strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
                r.Offset(0, -1) & "'!"
            r.Offset(0, 9).Formula = "=" & strSource & r.Value
           r.Offset(0, 10).Formula = "=" & strSource & r.Offset(0, 1).Value
           r.Offset(0, 11).Formula = "=" & strSource & r.Offset(0, 2).Value
           r.Offset(0, 12).Formula = "=" & strSource & r.Offset(0, 3).Value
           r.Offset(0, 13).Formula = "=" & strSource & r.Offset(0, 4).Value
            r.Offset(0, 14).Formula = "=" & strSource & r.Offset(0, 5).Value
            r.Offset(0, 15).Formula = "=" & strSource & r.Offset(0, 6).Value
             r.Offset(0, 16).Formula = "=" & strSource & r.Offset(0, 7).Value

        Next r
    Application.ScreenUpdating = True
    End With
End Sub

[snasui]

ลองดูว่าใช่ที่ต้องการหรือไม่ครับ

Code: Select all

Sub Test0()
    Dim rAll As Range
    Dim r As Range, strSource As String
    Dim i As Integer
    Application.ScreenUpdating = False
    With ActiveSheet
        Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For Each r In rAll
            strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
                r.Offset(0, -1) & "'!"
            For i = 9 To 16
                r.Offset(0, i).Formula = "=" & strSource & r.Offset(0, i - 9).Value
            Next i
'            r.End(xlToRight).Value
        Next r
    Application.ScreenUpdating = True
    End With
End Sub

[Arm_anucha]

ตรงกับความต้องการครับ ขอบคุณครับ