Lấy ký tự trong chuỗi

Liên hệ QC

bin.vcsc

Thành viên hoạt động
Tham gia
6/12/13
Bài viết
125
Được thích
12
Bin có chuỗi cần tách lấy dữ liệu trong chuỗi mong anh chị và các bạn giúp đỡ cách xử lý chuỗi này.
Xin cảm ơn mọi người.
1647264298908.png
 

File đính kèm

  • Lấy ký tự trong chuỗi.xlsx
    9.4 KB · Đọc: 14
Gõ vào ô cột B2 : =TRIM(SUBSTITUTE(SUBSTITUTE(A2,CHAR(13)," "),CHAR(10)," "))
Copy/Paste Values
Dùng text-to-columns.
Cám ơn bác @VetMini. Thú thật đây là mã trạng thái của nhân viên giao hàng quét lên gồm:mã trạng thái, ngày quét và giờ quét. Mỗi dòng là trạng thái của một lô hàng, nên số lượng mã có thể thay đổi không cố định.
Bin gửi lại tệp có thêm một số chuỗi khác nữa phía sau.
Cám ơn.
 

File đính kèm

  • Lấy ký tự trong chuỗi_new.xlsx
    9.6 KB · Đọc: 17
Là người làm việc với dữ liệu chuyển đổi, giao đổi từ các hệ thống và các giao diện khác nhau, bạn phải tự biết có bổn phận học hỏi những cách thức lọc, xếp chúng. Điển hình, ngày nay bộ Power BI nói chung, và Power Query nói riêng có khả năng giúp bạn làm việc này.

Làm thủ công như tôi kể trên không khó lắm. Nhưng nếu một ngày phải làm một chục cái như vậy thì hơi mệt.

Nếu, và chỉ nếu, một ngày làm từ 5-6 cái như trên thì có thể viết code VBA để giải quyết. Tôi lười viết code mò đường, cái kiểu làm đại sau đó cứ phải chỉnh lại, lắm. Để chờ bạn nào đoán ý giỏi hơn tôi thì xung phong đi trước.

Nhưng nếu bạn không chịu khó học VBA thì code giùm bạn chỉ là giải pháp tạm bợ. Tự bạn phải biết tự chủ và tự tiến. Nguyên tắc của giúp đỡ kỹ thuật là bạn phải làm hết, những chỗ nào bí thì mới hỏi. Bạn không thể ngẫng mặt nhìn người làm cùng phòng cùng cấp trong khi hầu hết công việc của bạn do người khác làm giùm (quan điểm chỉ việc bấm nút môt phát như hầu hết các người xin code ở GPE)

Con đường lâu dài là bám sát những cải tiến áp dụng vi tính. Chịu khó thay vì đi nhậu thì bỏ thì giờ cập nhật kiến thức với các công cụ mới của Microsoft nói chung và Excel nói riêng.

Trừ trường hợp bạn nghĩ là trong tương lai mình sẽ làm công việc khác và giao cái của nợ này cho người khác.
 
Cám ơn bác @VetMini. Thú thật đây là mã trạng thái của nhân viên giao hàng quét lên gồm:mã trạng thái, ngày quét và giờ quét. Mỗi dòng là trạng thái của một lô hàng, nên số lượng mã có thể thay đổi không cố định.
Bin gửi lại tệp có thêm một số chuỗi khác nữa phía sau.
Cám ơn.
Không biết công thức của tôi có làm bạn sợ không ( hơi phức tạp )

Bạn check thử xem đúng ý bạn không nha.
 

File đính kèm

  • Lấy ký tự trong chuỗi_new.xlsx
    10.2 KB · Đọc: 9
Code thực hiện. Bài này thuật toán chỉ thường thoi, nhưng dữ liệu tùm lùm code rắc rối bỏ bố.
Tôi chỉ chú trọng dữ liệu, không có hứng về mẫu mã. Bạn tự tạo mẫu mã lấy.

Mã:
Sub totite()
Const COTDULIEU = "A"
Const DONGBATDAU = 3
Dim a(1 To 100, 1 To 50) ' hope that the delivery note has less than 100 items, and less than 50 cycles
For Each cll In Range(COTDULIEU & DONGBATDAU, COTDULIEU & Range(COTDULIEU & ":" & COTDULIEU).Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row)
    i = i + 1 ' prepare next line transaction
    j = 1 ' reset column for next line transaction
    For Each itm In Split(Application.Trim(Replace(Replace(Replace(cll.Value, Chr(13), "^"), Chr(13), "^"), "^^", "^")), "^") ' horrible!
        If itm <> "" Then
            details = Split(Application.Trim(Replace(itm, "@", " ")), " ") ' always 0:partID, 1,2: date, 4: whatever)
            dte = CDate(details(1) & " " & details(2)) ' gets date time
            itmCol = Application.Match(details(0), Application.Index(a, i, 0), 0)
            If Not IsNumeric(itmCol) Then ' item already there
                ' new item within transaction
                itmCol = j
                a(i, itmCol) = details(0)
                j = j + 4 ' update postion for next item in this line transaction
            End If
            If dte > a(i, itmCol + 1) + a(i, itmCol + 2) Then
                a(i, itmCol + 1) = Fix(dte) ' date only
                a(i, itmCol + 2) = dte - a(i, j + 1)
                a(i, itmCol + 3) = Replace(Split(details(3), "-")(1), ")", "")
            End If
        End If
    Next itm
Next cll
Range(COTDULIEU & DONGBATDAU).Offset(, 1).Resize(i, j).Value = a
End Sub

Trước đó, tôi viết code sau, sử dụng dictionary, nhưng viết nửa chừng thì nhớ ra máy mình không có script engine của Windows, và bỏ dở. Tôi chuyển viết code như trên, dùng hàm macth để dò mảng.

Code này đang viết dở, nếu bạn có hứng thì cứ tiếp nó.

Mã:
Sub totite2()
Const COTDULIEU = "A"
Const DONGBATDAU = 3
Const ROWMAX = 100
Const COLMAX = 50
Dim a(1 To ROWMAX, 1 To COLMAX) ' hope that the delivery note has less than 100 items, and less than 50 cycles
With CreateObject("Scripting.Dictionary")
    For Each cll In Range(COTDULIEU & DONGBATDAU).CurrentRegion.Resize(, 1)
    ' resized to ensure that only one column is involved
    ' hình như ô A2 cũng có chứa gì đó, currentregion chép cả nó. Cần chỉnh
        i = i + 1 ' prepare next line transaction
        j = 1 ' reset column for next line transaction
        For Each itm In Split(Replace(Replace(Replace(cll.Value, Chr(13), "^"), Chr(13), "^"), "^^", "^"), "^") ' horrible!
            details = Application.Trim(Split(Replace(itm, "@", " "), " ")) ' always 0:partID, 1,2: date, 4: whatever)
            dte = CDate(details(1) & " " & details(2)) ' gets date time
            If Not .Exists(details(0)) Then
                a(i, j) = details(0)
                a(i, j + 1) = Fix(dte) ' date only
                a(i, j + 2) = dte - a(i, j + 1)
                a(i, j + 3) = Replace(Split(details(3), "-")(1), ")", "")
                'Add details(0), i & ":" & j
                j = j + 4 ' update postion for next item in this line transaction
            Else
            ' thêm code ở đây
            End If
        Next itm
    Next cll
End With
' gán mảng ở đây
End Sub
 
Lần chỉnh sửa cuối:
Cám ơn bác @VetMini. Thú thật đây là mã trạng thái của nhân viên giao hàng quét lên gồm:mã trạng thái, ngày quét và giờ quét. Mỗi dòng là trạng thái của một lô hàng, nên số lượng mã có thể thay đổi không cố định.
Bin gửi lại tệp có thêm một số chuỗi khác nữa phía sau.
Cám ơn.
Dữ liệu xuất từ phần mềm với số ký tự từng thành phần theo đúng chuẩn
Mã:
Sub ABC()
  Dim sArr(), res$(), vc27$, vc30$, vc$, sRow&, tmp$, N&, i&, j&, c&
 
  vc27 = "VCSC[27]": vc30 = "VCSC[30]"
  With Sheets("Sheet1")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 10)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    N = Len(tmp)
    c = 5
    For j = 1 To N Step 36
      vc = Mid(tmp, j, 8)
      If Mid(tmp, j, 8) = vc27 Then
        res(i, 1) = vc
        res(i, 2) = Mid(tmp, j + 9, 5)
        res(i, 3) = Mid(tmp, j + 15, 5)
        res(i, 4) = Mid(tmp, j + 30, 4)
      End If
      If Mid(tmp, j, 8) = vc30 Then
        res(i, c) = vc30
        res(i, c + 1) = Mid(tmp, j + 9, 5)
        res(i, c + 2) = Mid(tmp, j + 15, 5)
        If c = 5 Then c = 8
      End If
    Next j
  Next i
  Sheets("Sheet1").Range("C3").Resize(sRow, 10) = res
End Sub
 
Cám ơn bác @befaint đã quan tâm. Tệp xuất từ phần mềm ra chỉ giống như cột A2. Do số lượng nhiều Bin chỉ lấy đại diện một vài mẫu để thực hành.
Mong nhận được hỗ trợ.

Vấn đề không phải giống hay khác. Mà vấn đề ở chỗ phải thêm công đoạn chép dữ liệu từ tệp xuất từ phần mềm vào Excel: Tốn thời gian, dữ liệu chép vào không chắc được giữ nguyên.

Và vấn đề là có người nhìn ra vấn đề trên hiểu được vấn đề cần được giải quyết từ tệp ban đầu, chứ không phải cái trung gian.
 
Code thực hiện. Bài này thuật toán chỉ thường thoi, nhưng dữ liệu tùm lùm code rắc rối bỏ bố.
Tôi chỉ chú trọng dữ liệu, không có hứng về mẫu mã. Bạn tự tạo mẫu mã lấy.

Mã:
Sub totite()
Const COTDULIEU = "A"
Const DONGBATDAU = 3
Dim a(1 To 100, 1 To 50) ' hope that the delivery note has less than 100 items, and less than 50 cycles
For Each cll In Range(COTDULIEU & DONGBATDAU, COTDULIEU & Range(COTDULIEU & ":" & COTDULIEU).Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row)
    i = i + 1 ' prepare next line transaction
    j = 1 ' reset column for next line transaction
    For Each itm In Split(Application.Trim(Replace(Replace(Replace(cll.Value, Chr(13), "^"), Chr(13), "^"), "^^", "^")), "^") ' horrible!
        If itm <> "" Then
            details = Split(Application.Trim(Replace(itm, "@", " ")), " ") ' always 0:partID, 1,2: date, 4: whatever)
            dte = CDate(details(1) & " " & details(2)) ' gets date time
            itmCol = Application.Match(details(0), Application.Index(a, i, 0), 0)
            If Not IsNumeric(itmCol) Then ' item already there
                ' new item within transaction
                itmCol = j
                a(i, itmCol) = details(0)
                j = j + 4 ' update postion for next item in this line transaction
            End If
            If dte > a(i, itmCol + 1) + a(i, itmCol + 2) Then
                a(i, itmCol + 1) = Fix(dte) ' date only
                a(i, itmCol + 2) = dte - a(i, j + 1)
                a(i, itmCol + 3) = Replace(Split(details(3), "-")(1), ")", "")
            End If
        End If
    Next itm
Next cll
Range(COTDULIEU & DONGBATDAU).Offset(, 1).Resize(i, j).Value = a
End Sub

Trước đó, tôi viết code sau, sử dụng dictionary, nhưng viết nửa chừng thì nhớ ra máy mình không có script engine của Windows, và bỏ dở. Tôi chuyển viết code như trên, dùng hàm macth để dò mảng.

Code này đang viết dở, nếu bạn có hứng thì cứ tiếp nó.

Mã:
Sub totite2()
Const COTDULIEU = "A"
Const DONGBATDAU = 3
Const ROWMAX = 100
Const COLMAX = 50
Dim a(1 To ROWMAX, 1 To COLMAX) ' hope that the delivery note has less than 100 items, and less than 50 cycles
With CreateObject("Scripting.Dictionary")
    For Each cll In Range(COTDULIEU & DONGBATDAU).CurrentRegion.Resize(, 1)
    ' resized to ensure that only one column is involved
    ' hình như ô A2 cũng có chứa gì đó, currentregion chép cả nó. Cần chỉnh
        i = i + 1 ' prepare next line transaction
        j = 1 ' reset column for next line transaction
        For Each itm In Split(Replace(Replace(Replace(cll.Value, Chr(13), "^"), Chr(13), "^"), "^^", "^"), "^") ' horrible!
            details = Application.Trim(Split(Replace(itm, "@", " "), " ")) ' always 0:partID, 1,2: date, 4: whatever)
            dte = CDate(details(1) & " " & details(2)) ' gets date time
            If Not .Exists(details(0)) Then
                a(i, j) = details(0)
                a(i, j + 1) = Fix(dte) ' date only
                a(i, j + 2) = dte - a(i, j + 1)
                a(i, j + 3) = Replace(Split(details(3), "-")(1), ")", "")
                'Add details(0), i & ":" & j
                j = j + 4 ' update postion for next item in this line transaction
            Else
            ' thêm code ở đây
            End If
        Next itm
    Next cll
End With
' gán mảng ở đây
End Sub
Xin cảm ơn bác @VetMini đã luôn quan tâm và giúp đỡ
 
Dữ liệu xuất từ phần mềm với số ký tự từng thành phần theo đúng chuẩn
Mã:
Sub ABC()
  Dim sArr(), res$(), vc27$, vc30$, vc$, sRow&, tmp$, N&, i&, j&, c&
 
  vc27 = "VCSC[27]": vc30 = "VCSC[30]"
  With Sheets("Sheet1")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 10)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    N = Len(tmp)
    c = 5
    For j = 1 To N Step 36
      vc = Mid(tmp, j, 8)
      If Mid(tmp, j, 8) = vc27 Then
        res(i, 1) = vc
        res(i, 2) = Mid(tmp, j + 9, 5)
        res(i, 3) = Mid(tmp, j + 15, 5)
        res(i, 4) = Mid(tmp, j + 30, 4)
      End If
      If Mid(tmp, j, 8) = vc30 Then
        res(i, c) = vc30
        res(i, c + 1) = Mid(tmp, j + 9, 5)
        res(i, c + 2) = Mid(tmp, j + 15, 5)
        If c = 5 Then c = 8
      End If
    Next j
  Next i
  Sheets("Sheet1").Range("C3").Resize(sRow, 10) = res
End Sub
Cám ơn bác @HieuCD đã giúp đỡ.
Tuy nhiên Bin có vài chỗ chưa rõ mong bác giải thích giúp.


1) Mình muốn tìm thêm một số mã khác thì thêm ở đây đúng không ah?

vc27 = "VCSC[27]": vc30 = "VCSC[30]" <= Thêm mã cần tìm ở đây

2) Số 10 ở đây có phải là số cột không? Nếu thêm 1 mã và có thêm 2 cột kết quả nữa thì có phải chỉnh số 10 thành số 12 phải không?
ReDim res(1 To sRow, 1 To 10)

3) ý nghĩa của c=5/ c=8 này là gì?


For i = 1 To sRow
tmp = sArr(i, 1)
N = Len(tmp)
c = 5
...
If c = 5 Then c = 8

4) To N Step 36 này ý nghĩa là gì? Có phải là 36 lần lặp lại không?

For j = 1 To N Step 36

5) Làm cách nào để mình có thể tìm ra được quy luật này? Ý nghĩa của đoạn mã này? Tại sao chỉ cần đến res(i,4)=...là đủ
res(i, 1) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)

Biết là sẽ làm phiền nhưng do muốn học hỏi thêm. Mong bác dành chút thời gian chỉ điểm giúp.
Nếu bác có số điện thoại cho Bin xin nha. Bin có nhiều cái cũng muốn trao đổi riêng.
Cám ơn và chúc sức khỏe.
 
Cám ơn bác @HieuCD đã giúp đỡ.
Tuy nhiên Bin có vài chỗ chưa rõ mong bác giải thích giúp.


1) Mình muốn tìm thêm một số mã khác thì thêm ở đây đúng không ah?

vc27 = "VCSC[27]": vc30 = "VCSC[30]" <= Thêm mã cần tìm ở đây

2) Số 10 ở đây có phải là số cột không? Nếu thêm 1 mã và có thêm 2 cột kết quả nữa thì có phải chỉnh số 10 thành số 12 phải không?
ReDim res(1 To sRow, 1 To 10)

3) ý nghĩa của c=5/ c=8 này là gì?


For i = 1 To sRow
tmp = sArr(i, 1)
N = Len(tmp)
c = 5
...
If c = 5 Then c = 8

4) To N Step 36 này ý nghĩa là gì? Có phải là 36 lần lặp lại không?

For j = 1 To N Step 36

5) Làm cách nào để mình có thể tìm ra được quy luật này? Ý nghĩa của đoạn mã này? Tại sao chỉ cần đến res(i,4)=...là đủ
res(i, 1) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)

Biết là sẽ làm phiền nhưng do muốn học hỏi thêm. Mong bác dành chút thời gian chỉ điểm giúp.
Nếu bác có số điện thoại cho Bin xin nha. Bin có nhiều cái cũng muốn trao đổi riêng.
Cám ơn và chúc sức khỏe.
1) Mình muốn tìm thêm một số mã khác thì thêm ở đây đúng không ah? vc27 = "VCSC[27]": vc30 = "VCSC[30]": Đúng rùi nhưng phải viết thêm lệnh để lấy thêm mã mới

2) Số 10 ở đây có phải là số cột không? Nếu thêm 1 mã và có thêm 2 cột kết quả nữa thì có phải chỉnh số 10 thành số 12 phải không? ReDim res(1 To sRow, 1 To 10: Chính xác 100%

3) ý nghĩa của c=5/ c=8 này là gì? C là thứ tự cột kết quả của mã VCSC[30], cột 5 là "dòng" đầu tiên cột 8 là "dòng" cuối của mã VCSC[30]. Nếu thêm mã mới phải xác định cột kết quả mới

4) To N Step 36 này ý nghĩa là gì? Có phải là 36 lần lặp lại không?: 36 là số ký tự của 1 mã, step 36 là mỗi bước nhảy 36 ký tự là 1 mã

5) Làm cách nào để mình có thể tìm ra được quy luật này? Ý nghĩa của đoạn mã này? Tại sao chỉ cần đến res(i,4)=...là đủ
res(i, 1) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)

Phải đếm thủ công các con số 9, 5, 15, 5 ....
Là kết quả của VCSC[27] nên chỉ có 4 cột
 
1) Mình muốn tìm thêm một số mã khác thì thêm ở đây đúng không ah? vc27 = "VCSC[27]": vc30 = "VCSC[30]": Đúng rùi nhưng phải viết thêm lệnh để lấy thêm mã mới

2) Số 10 ở đây có phải là số cột không? Nếu thêm 1 mã và có thêm 2 cột kết quả nữa thì có phải chỉnh số 10 thành số 12 phải không? ReDim res(1 To sRow, 1 To 10: Chính xác 100%

3) ý nghĩa của c=5/ c=8 này là gì? C là thứ tự cột kết quả của mã VCSC[30], cột 5 là "dòng" đầu tiên cột 8 là "dòng" cuối của mã VCSC[30]. Nếu thêm mã mới phải xác định cột kết quả mới

4) To N Step 36 này ý nghĩa là gì? Có phải là 36 lần lặp lại không?: 36 là số ký tự của 1 mã, step 36 là mỗi bước nhảy 36 ký tự là 1 mã

5) Làm cách nào để mình có thể tìm ra được quy luật này? Ý nghĩa của đoạn mã này? Tại sao chỉ cần đến res(i,4)=...là đủ
res(i, 1) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)

Phải đếm thủ công các con số 9, 5, 15, 5 ....
Là kết quả của VCSC[27] nên chỉ có 4 cột
Cám ơn bác @HieuCD rất nhiều.
Em vẫn có một thắc mắc là, giá trị VCSC[30] thay đổi vị trí, số lượng thì đoạn mã nào bác làm công việc này. Bin xem nhiều lần vẫn còn có thắc mắc này.

Và Bin có thêm thử một giá trị nữa VCSC[26] vào cột 11 và có viết lại code nhưng chạy không được, bác xem hộ Bin chỗ nào bị sai giúp với.

1647660775566.png
=========================================================
Sub ABC2()
Dim sArr(), res$(), vc27$, vc30$, vc26$, vc$, sRow&, tmp$, N&, i&, j&, c&

vc27 = "VCSC[27]": vc30 = "VCSC[30]": vc26 = "VCSC[26]"
With Sheets("Sheet1")
sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
ReDim res(1 To sRow, 1 To 14)
For i = 1 To sRow
tmp = sArr(i, 1)
N = Len(tmp)
c = 5
c = 11
For j = 1 To N Step 36
vc = Mid(tmp, j, 8)
If Mid(tmp, j, 8) = vc27 Then
res(i, 1) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)

ElseIf Mid(tmp, j, 8) = vc30 Then
res(i, c) = vc30
res(i, c + 1) = Mid(tmp, j + 9, 5)
res(i, c + 2) = Mid(tmp, j + 15, 5)
If c = 5 Then c = 8

If Mid(tmp, j, 8) = vc26 Then
res(i, c) = vc
res(i, 2) = Mid(tmp, j + 9, 5)
res(i, 3) = Mid(tmp, j + 15, 5)
res(i, 4) = Mid(tmp, j + 30, 4)
If c = 11 Then
End If
Next j
Next i
Sheets("Sheet1").Range("C3").Resize(sRow, 14) = res
End Sub
=========================================================
 

File đính kèm

  • Lấy ký tự trong chuỗi_GPE.xlsm
    22.9 KB · Đọc: 6
Web KT
Back
Top Bottom