เพื่อมุ่งให้เกิดคุณภาพจากการอบรมสูงสุด Excel Expert Training ให้การอบรม Excel กลุ่มเล็กๆ ไม่เกิน 6 คนทุกคนสามารถเรียนรู้ Excel อย่างใกล้ชิด จะมาคนเดียวหรือมาเป็นกลุ่มแล้วนัดวันอบรมแบบส่วนตัวก็ได้ ผู้เข้าอบรมทุกคนสามารถติดตามเนื้อหาที่อบรมได้อย่างชัดเจนจากจอภาพด้านหน้าของตัวเอง
Page 5 of 5 FirstFirst ... 345
Results 41 to 49 of 49

Thread: ช่วยแนะนำการแยกข้อมูลStringที่อยู่ในcellเดียวกันให้อยู่คนละcellหน่อยคะ

  1. #41
    anntiant
    Guest

    Smile

    Quote Originally Posted by chatchat View Post
    สวัสดีครับ

    หายไปหลายวัน เข้ามาดูอีกที ไม่คิดว่าจะ reply เยอะขนาดนี้
    ผมย้อนกลับไป คำถามของคุณ anntiant เข้าใจว่าในโจทย์ มี part แค่ 1 กับ 2 เท่านั้น ผมเลยใช้ if then else ธรรมดา ส่วนถ้าจะให้ work จริงๆ ก็ของคุณ rundim ครับ
    แล้วถ้าจะใช้ code ของคุณ chatchat เขียนให้ออกมาเหมือนของคุณ rundim จะเป็นไปได้มั้ยถ้าทำได้ จะต้องใช้ code ยังไงคะ

  2. #42
    rundim
    Guest
    ดูแล้วสามารถทำได้ครับ
    เดี๋ยวจะลองแก้ให้ดูนะครับ ถ้ามีเวลาว่างนะครับ

  3. #43
    anntiant
    Guest

    Smile

    Quote Originally Posted by rundim View Post
    ดูแล้วสามารถทำได้ครับ
    เดี๋ยวจะลองแก้ให้ดูนะครับ ถ้ามีเวลาว่างนะครับ
    รบกวนหน่อยนะคะ
    ขอบคุณมากคะ

  4. #44
    chatchat
    Guest
    สวัสดีครับ

    ผม coding ให้ใหม่หมดเลยนะ จากเดิมดูแค่ 2 part เปลี่ยนเป็นวนลูปเช็คทั้งข้อความ แล้วตัดมาเรียงที่ cell ใหม่
    ให้ผลลัพธ์เหมือนของคุณrundim แต่จะประมวลผลเร็วกว่า กรณีที่ source มีจำนวนมากๆ และ code ก็น่าจะ็ดูเข้าใจง่ายนะครับ
    Code:
     Sub Macro()
    Sheet2.Range("A2:D65536").ClearContents
    Dim a, bb, posMfg, posPart, c, posPartEnd, Ro, RoPart, RoMfg As Integer
    Dim txtMfg, txtPart, cutText, ExText As String
    Ro = 3
    RoPart = 2
    RoMfg = 2
    Do
    ExText = Worksheets("sheet1").Cells(Ro, 2).Text & "|||"
    Worksheets("sheet2").Cells(RoMfg, 1).Value = Worksheets("sheet1").Cells(Ro, 1).Value
    Worksheets("sheet2").Cells(RoMfg, 4).Value = Worksheets("sheet1").Cells(Ro, 3).Value
    a = Len(ExText)
    For bb = 1 To a
        posMfg = InStr(bb + 1, ExText, "Mfg:", vbTextCompare) ' ËÒµÓá˹觢ͧ Mfg:
                If posMfg = 0 Then 
                    posMfg = Len(ExText)
                 Else: End If
            For c = 1 To posMfg
                    If bb = 1 Then          
                            cutText = Mid(ExText, bb, posMfg - 3)
                     Else
                            cutText = Mid(ExText, bb - 1, posMfg - (bb + 1))
                    End If
                    posPart = InStr(c, cutText, "Part:", vbTextCompare) '12
                    c = c + posPart
                          posPartEnd = InStr(c, cutText, "Part:", vbTextCompare) '36
                            If posPartEnd = 0 Then 
                                txtPart = Mid(cutText, posPart + 5, Len(cutText) - (posPart))
                                Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
                                RoPart = RoPart + 1
                                Exit For 'c
                            Else 'part µÑÇÊØ´·éÒÂáÅéÇ
                                txtPart = Mid(cutText, posPart + 5, posPartEnd - posPart - 6)
                                Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
                                RoPart = RoPart + 1
                            End If
                                    Next c
            txtMfg = Mid(cutText, 5, InStr(1, cutText, "Part:", vbTextCompare) - 6) 'áÊ´§ª×èÍ Mfg:
            Worksheets("sheet2").Cells(RoMfg, 2).Value = txtMfg
            
            RoMfg = RoMfg + (RoPart - RoMfg)
         bb = posMfg
    Next bb
    Ro = Ro + 1
    Loop Until Worksheets("sheet1").Cells(Ro, 2).Text = ""
    Worksheets("sheet2").Select
    End Sub

  5. #45
    anntiant
    Guest

    Smile

    ขอบคุณ คุณ chatchat มากนะคะ สุดยอดจริงๆคะ
    แต่หนูลองใส่ข้อมูลที่มี part มากกว่า 3 คือตั้งแต่ 4 ขึ้นไปแล้วมันจะขึ้น cell ใหม่คะ
    code เดิมก็เหมือนกัน( พอดีลองใส่ loop ใหม่ใน code ของคุณแล้ว ผลที่ออกมาคือ
    ถ้ามี part 3 ตัวก็จะเรียงได้ แต่ถ้ามี 4 ตัวขึ้นไป part ตัวต่อไปก็จะต่อ part ตัวที่ 3คะ
    ไม่ขึ้นบรรทัดใหม่)
    คือข้อมูลจริงของหนู mfg และ part จะมีไม่จำกัดหนะคะ

    แล้วถ้าต้องทำให้เป็น Function ต้องกำหนดตัวแปรยังไงคะ ช่วยสอนหน่อย จะเอาไปทำเป็น
    add ins คะ

  6. #46
    rundim
    Guest
    Code:
     
    Option Explicit
    Sub Septext()
    Dim a, b, c, d, e, f, g As String
    Dim ccStr, cRo, startText, cRowTxt As Integer
    Dim cMfg As Integer
    Dim countaTxt As Integer
    Dim bb, cc, dd As Integer
    cRo = 2
    countaTxt = 2
    cRowTxt = 2
    startText = 1
        Sheets("Sheet2").Select
        Cells.Clear
        Cells.HorizontalAlignment = xlLeft
        Range("A1").Value = "Item number"
        Range("B1").Value = "Mfg"
        Range("C1").Value = "Part"
    Do
    Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) 'ãÊèàÅ¢ÃËÑÊ¢éҧ˹éÒ
    a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value
    b = InStr(1, a, ":", vbTextCompare)
    c = Worksheets("Sheet1").Cells(countaTxt, cRowTxt).Characters.Count
    a = Mid(a, b + 1, c - b)
    d = InStr(1, a, "part:", vbTextCompare)
    If d = 0 Then GoTo finish2
    f = Mid(a, 1, d - 2)
    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f
    '====================================================
       Do
                                Do
     
                                    b = InStr(1, a, ",part:", vbTextCompare)
                                    a = Mid(a, b + 6, c - b)
                                    d = InStr(1, a, "||Mfg:", vbTextCompare)
                                    b = InStr(1, a, ",part:", vbTextCompare)
                           If d = 0 And b = 0 Then GoTo finish
                                    f = Mid(a, 1, b - 1)
                                    g = InStr(1, f, "Mfg:", vbTextCompare)
                                                '*******************
     
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
                                             cRo = cRo + 1
                                             Else: End If
     
                                Loop While g = 0
                                    f = Mid(f, 1, d - 1)
                                    g = InStr(1, f, "Mfg:", vbTextCompare)
                                                '*******************
     
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
                                             cRo = cRo + 1
                                             Else: End If
     
     
     
                                Do
                                    b = InStr(1, a, "||Mfg:", vbTextCompare)
                                    a = Mid(a, b + 6, c - b)
                                    d = InStr(1, a, ",part:", vbTextCompare)
                                    b = InStr(1, a, "||Mfg:", vbTextCompare)
                                    f = Mid(a, 1, d - 1)
                                    g = InStr(1, f, ",part:", vbTextCompare)
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f 'Mfg
                                             Else: End If
                                 Loop While g <> 0
     Loop While g = 0
    finish:
    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = a 'Part string
    cRo = cRo + 1
    countaTxt = countaTxt + 1: GoTo out
    finish2:
    MsgBox "&auml;&Aacute;&egrave;&Aacute;&Otilde; Part", vbOKOnly
    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = a
    cRo = cRo + 1
    countaTxt = countaTxt + 1
    out:
    Loop Until Sheet1.Cells(countaTxt, 1) = ""
    End Sub
    ช่วยลอง test Code นี้หน่อยนะครับ

  7. #47
    anntiant
    Guest

    Smile

    Quote Originally Posted by rundim View Post
    Code:
     
    Option Explicit
    Sub Septext()
    Dim a, b, c, d, e, f, g As String
    Dim ccStr, cRo, startText, cRowTxt As Integer
    Dim cMfg As Integer
    Dim countaTxt As Integer
    Dim bb, cc, dd As Integer
    cRo = 2
    countaTxt = 2
    cRowTxt = 2
    startText = 1
        Sheets("Sheet2").Select
        Cells.Clear
        Cells.HorizontalAlignment = xlLeft
        Range("A1").Value = "Item number"
        Range("B1").Value = "Mfg"
        Range("C1").Value = "Part"
    Do
    Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) '&atilde;&Ecirc;&egrave;&agrave;&Aring;&cent;&Atilde;&Euml;&Ntilde;&Ecirc;&cent;&eacute;&Ograve;&sect;&Euml;&sup1;&eacute;&Ograve;
    a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value
    b = InStr(1, a, ":", vbTextCompare)
    c = Worksheets("Sheet1").Cells(countaTxt, cRowTxt).Characters.Count
    a = Mid(a, b + 1, c - b)
    d = InStr(1, a, "part:", vbTextCompare)
    If d = 0 Then GoTo finish2
    f = Mid(a, 1, d - 2)
    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f
    '====================================================
       Do
                                Do
     
                                    b = InStr(1, a, ",part:", vbTextCompare)
                                    a = Mid(a, b + 6, c - b)
                                    d = InStr(1, a, "||Mfg:", vbTextCompare)
                                    b = InStr(1, a, ",part:", vbTextCompare)
                           If d = 0 And b = 0 Then GoTo finish
                                    f = Mid(a, 1, b - 1)
                                    g = InStr(1, f, "Mfg:", vbTextCompare)
                                                '*******************
     
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
                                             cRo = cRo + 1
                                             Else: End If
     
                                Loop While g = 0
                                    f = Mid(f, 1, d - 1)
                                    g = InStr(1, f, "Mfg:", vbTextCompare)
                                                '*******************
     
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
                                             cRo = cRo + 1
                                             Else: End If
     
     
     
                                Do
                                    b = InStr(1, a, "||Mfg:", vbTextCompare)
                                    a = Mid(a, b + 6, c - b)
                                    d = InStr(1, a, ",part:", vbTextCompare)
                                    b = InStr(1, a, "||Mfg:", vbTextCompare)
                                    f = Mid(a, 1, d - 1)
                                    g = InStr(1, f, ",part:", vbTextCompare)
                                            If g = 0 Then
                                                    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f 'Mfg
                                             Else: End If
                                 Loop While g <> 0
     Loop While g = 0
    finish:
    Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = a 'Part string
    cRo = cRo + 1
    countaTxt = countaTxt + 1: GoTo out
    finish2:
    MsgBox "&auml;&Aacute;&egrave;&Aacute;&Otilde; Part", vbOKOnly
    Worksheets("sheet2").Cells(cRo, cRowTxt).Value = a
    cRo = cRo + 1
    countaTxt = countaTxt + 1
    out:
    Loop Until Sheet1.Cells(countaTxt, 1) = ""
    End Sub
    ช่วยลอง test Code นี้หน่อยนะครับ
    ได้แล้วคะ ขอบคุณมากกกๆๆนะคะ เก่งจังคะ
    ถ้าหนูจะทำเป็น Function ต้องทำไงบ้างคะ แนะนำหน่อยคะ
    จะทำเป็น add ins เพราะคอลัมน์ของ mfg และ Item ในไฟล์ต่างๆ
    อาจไม่ได้อยู่ใน column A และ B อย่างในไฟล์ที่โพส
    ก็เลยต้องให้ user คีย์มาว่า mfg และ Item อยู่ในคอลัมน์อะไร
    ในกรณีนี้ สามารถทำเป็น add ins ได้มั้ยคะ ได้หรือไม่ได้ช่วยบอกด้วยคะ
    หรือควรใช้วิธีอื่น ช่วยแนะนำด้วยนะคะ

    ขอบคุณทุกคนมากนะคะที่มาช่วยตอบให้...ซาบซึ้งจริงๆคะ

  8. #48
    chatchat
    Guest

    Wink

    ข้างล่างนี้ฉบับแก้ไขนะ
    จากคำถามที่ว่า จะทำ add in ยังไง สร้าง ฟังก์ชั่นยังไง ผมว่ามีคำตอบให้แล้ว ลองค้นๆดู คำถามเก่าๆนะครับ เพราะไม่งั้น จะกลายเป็นว่า ทำให้หมดทุกอย่างเลย มาถึงขั้นตอนนี้ผมว่าคงไม่ยากแล้วล่ะครับ เพราะถ้าเอา code เอา add-in ไปใช้เลย โดยไม่ทราบว่ามันทำงานยังไง จะผิดจุดประสงค์ของบอร์ดนะครับ
    ผมว่าคุณลองเอา add-in function ที่คุณได้ลองสร้างขึ้นมาแล้ว มาให้หลายๆคนในบอร์ดนี้ดู และช่วยให้คำแนะนำ แบบนี้จะได้ประโยชน์กว่านะครับ
    Code:
    Sub Macro()
    Sheet2.Range("A2:D65536").ClearContents
    Dim a, bb, posMfg, posPart, c, posPartEnd, Ro, RoPart, RoMfg As Integer
    Dim txtMfg, txtPart, cutText, ExText As String
    Ro = 3 'เริ่มแแถวที่เท่าไหร่
    RoPart = 2
    RoMfg = 2
    Do
    ExText = Worksheets("sheet1").Cells(Ro, 2).Text & "|||"
    Worksheets("sheet2").Cells(RoMfg, 1).Value = Worksheets("sheet1").Cells(Ro, 1).Value
    Worksheets("sheet2").Cells(RoMfg, 4).Value = Worksheets("sheet1").Cells(Ro, 3).Value
    a = Len(ExText)
    For bb = 1 To a
        posMfg = InStr(bb + 1, ExText, "Mfg:", vbTextCompare) ' หาตำแหน่งของ Mfg:
                If posMfg = 0 Then 'ถ้าบรรทัดนี้มี mfg: เดียว
                    posMfg = Len(ExText)
                 Else: End If 'ถ้าบรรทัดนี้มี mfg: เดียว
            For c = 1 To posMfg
                    If bb = 1 Then            'เริ่มเช็คอักษรตัวแรก
                            cutText = Mid(ExText, bb, posMfg - 3)
                     Else
                            cutText = Mid(ExText, bb - 1, posMfg - (bb + 1))
                    End If
                    posPart = InStr(c, cutText, "Part:", vbTextCompare) '12
                    c = posPart 'แก้ไข
                          posPartEnd = InStr(posPart + 1, cutText, "Part:", vbTextCompare) '36
                            If posPartEnd = 0 Then 'เจอ part ตัวสุดท้ายแล้ว
                                txtPart = Mid(cutText, posPart + 5, Len(cutText) - (posPart))
                                Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
                                RoPart = RoPart + 1
                                Exit For 'c
                            Else 'part ตัวสุดท้ายแล้ว
                                txtPart = Mid(cutText, posPart + 5, posPartEnd - posPart - 6)
                                Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
                                RoPart = RoPart + 1
                            End If
                                    Next c
            txtMfg = Mid(cutText, 5, InStr(1, cutText, "Part:", vbTextCompare) - 6) 'แสดงชื่อ Mfg:
            Worksheets("sheet2").Cells(RoMfg, 2).Value = txtMfg
            
            RoMfg = RoMfg + (RoPart - RoMfg)
         bb = posMfg
    Next bb
    Ro = Ro + 1
    Loop Until Worksheets("sheet1").Cells(Ro, 2).Text = ""
    Worksheets("sheet2").Select
    End Sub

  9. #49
    anntiant
    Guest

    ขอบคุณ คุณ chatchat มากนะคะ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •