ขอความช่วยเหลือโค้ด VBA การตัดต่อข้อความ

[Wannakham2541]

สวัสดีครับทุกท่าน
ผมมีโจทย์ในการเขียนโค้ด VBA ให้โค้ดไปตัดข้อมูลบางส่วนไม่ได้ครับ
ตัวอย่าง
ข้อมูลจะเรียงมาเป็นคอลัมน์เดียวกัน
#37569# * 500#37898# * 400#37903# * 700#37983# * 87#37999# * 45#38043# * 299#38077# * 125#38101# * 1375#44589# * 450

ที่ต้องการ
เเต่ต้องการตัดลงมาเป็นอีกเเถวหนึ่ง เเบบด้านล่างนี้
#37569# * 500
#37898# * 400
#37903# * 700
#37983# * 87
#37999# * 45
#38043# * 299
#38077# * 125
#38101# * 1375
#44589# * 450

พอจะมีเเถวทางให้มั้ยครับ ขอบคุณล่วงหน้า สำหรับความช่วยเหลือ

[snasui]

กรุณาแนบไฟล์ Excel ที่ได้เขียน Code เอาไว้เองแล้วมาด้วย ถามกันเฉพาะที่ติดปัญหา กรุณาอ่านกฎการใช้บอร์ดข้อ 4 และ 5 ด้านบนประกอบครับ

[Wannakham2541]

Code: Select all

Sub Button1_Click()
    Dim wsDB As Worksheet, wsRes As Worksheet
    Set wsDB = Worksheets("Database")
    Set wsRes = Worksheets("Results")

    Dim iLastRow As Integer
    iLastRow = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row
    
    Dim iAddRow As Integer
    iAddRow = 2

    Dim arrParams() As String, arrGoods() As String
    Dim iLength As Integer, strGoodsID As String
    Dim i As Integer, j As Integer
    With wsDB
         For i = 2 To iLastRow
            arrParams() = Split(.Range("BD" & i).Value2, "#" & "#") 'ติดปัญหาตรงนี้เลย
            iLength = GetArrLength(arrParams)
            For j = 0 To iLength - 1
                 If Trim(arrParams(j)) <> "" Then
                    arrGoods() = Split(arrParams(j), "#")
                    strGoodsID = Trim(arrGoods(0))
                    .Range("A" & i & ":BC" & i).Copy
                    With wsRes
                        .Cells(iAddRow, "A").PasteSpecial xlPasteValues
                        .Cells(iAddRow, "BE").Value2 = strGoodsID
                    End With
                    iAddRow = iAddRow + 1
                End If
            Next j
        Next i
    End With
End Sub
Public Function GetArrLength(a As Variant) As Long
    If IsEmpty(a) Then
        GetArrLength = 0
    Else
        GetArrLength = UBound(a) - LBound(a) + 1
    End If
End Function

โค้ดที่ผมใช้ประมาณนี้ครับ เเละไฟล์ตัวอย่างครับ

[snasui]

การแยก String ในคอลัมน์ BD สามารถใช้ Code ด้านล่างครับ

Code: Select all

'Other code
With wsDB
     For i = 2 To iLastRow
        arrParams() = VBA.Split(.Range("BD" & i).Value2, vbLf) 
'Other code

[Wannakham2541]

ผมลองเเล้ว ผลลัพธ์ มันไม่ได้เเยกออกมาเเบบนี้อ่ะครับ
#37569# * 500
#37898# * 400
#37903# * 700
#37983# * 87
#37999# * 45
#38043# * 299
#38077# * 125
#38101# * 1375
#44589# * 450
ขอบคุณครับ

[snasui]

ที่เป็นเช่นนั้นเพราะ Code ที่เหลือเขียนไว้ไม่ตรงกับที่ต้องการ จะต้องปรับปรุงใหม่ หากตรวจสอบและแก้แล้วยังติดปัญหาสามารถถามมาใหม่ได้ตลอดเวลาครับ

ส่วน vbLf สามาถแบ่งค่า String ใส่เข้าไปใน Array ได้แล้วดังภาพ

vbLf.jpg

[Wannakham2541]

ทำได้เเล้วครับ ขอบคุณครับ