Option Explicit
Sub HL1901PLN()
Dim SArr, Res() As String, Tmp
Dim i, j, k
SArr = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
ReDim Res(1 To UBound(SArr), 1 To 4)
For i = 1 To UBound(SArr)
Tmp = Split(SArr(i, 1))
For j = 2 To UBound(Tmp)
If IsNumeric(Tmp(j)) = True And Len(Tmp(j)) >= 8 Then
k = k + 1
Res(i, k + 1) = Tmp(j)
End If
Next j
For j = UBound(Tmp) To 1 Step -1
If IsNumeric(Tmp(j)) = True And Len(Tmp(j)) = 1 And Len(Tmp(j - 1)) > 1 Then
Res(i, 4) = Tmp(j)
Exit For
End If
Next j
Res(i, 1) = Tmp(0)
k = 0
Next i
Sheet1.Range("B2", Sheet1.Range("E" & UBound(SArr) + 1)).ClearContents
Sheet1.Range("B2", Sheet1.Range("E" & UBound(SArr) + 1)) = Res
End SubThêm dòng này trước End Sub là được bạn.
Sheet1.Range("B2", Sheet1.Range("B1000000").End(xlUp)).NumberFormat = "@"Nhưng bạn cần nếu kết quả mong muốn của bạn trong những trường hợp đó đi chứ.
Bạn chạy thử Sub này xem sao.
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, R As Long, Tmp
sArr = Range("A2", Range("A2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To R
Tmp = Split(sArr(I, 1), " "): N = UBound(Tmp)
dArr(I, 1) = Tmp(0): dArr(I, 2) = "'" & Tmp(2)
dArr(I, 3) = "'" & Tmp(N - 2): dArr(I, 4) = Tmp(N - 1)
Next I
Range("B2:D2").Resize(R) = dArr
End Subdạ em gửi nhầm file cho anh, em gửi lại file cho anh xem, em có nêu tất cả trường hợp xảy ra, em có nêu kết quả tham khảo đó anh!
Vậy thì xét theo kiểu "lòng vòng".
Sub GPE()
Dim sArr, dArr(), I As Long, J As Long, N As Long, R As Long, Tmp
sArr = Range("A2", Range("A2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To UBound(sArr)
Tmp = Split(sArr(I, 1)): N = UBound(Tmp)
dArr(I, 1) = Tmp(0): dArr(I, 2) = Tmp(2)
For J = 3 To UBound(Tmp)
If IsNumeric(Tmp(J)) Then
N = J + 1: dArr(I, 3) = Tmp(J)
Exit For
End If
Next J
For J = UBound(Tmp) To N Step -1
If IsNumeric(Tmp(J)) And (Not IsNumeric(Tmp(J - 1)) Or J = N) Then
dArr(I, 4) = Tmp(J): Exit For
End If
Next J
Next I
Range("B2:E2").Resize(R) = dArr
End SubDòng 619:622 kết quả chắc chắn vậy không bạn?
Dòng 156 & 277 cũng vậy, kết quả chắc vậy ko
Mấy dòng này ăn khớp với nhóm kí tự thứ 2 từ trái sang của dữ liệu, không thấy giống những dòng còn lại.
PS: Bạn sửa bài viết bằng cách nào vậy?
Dạ xl anh trong file em đưa ra kết quả sai. dòng 619:622: còn dòng 156 và 277 thì đúng anh!
Hỏi lại cái này nữa cho chắc ròi sửa code 1 thể:
Bạn xem chơi đoạn code.
Option Explicit
Sub LANNAYNUATHOINHE()
Dim SArr, Res() As String
Dim Nms, Tmp
Dim i, j
SArr = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
ReDim Res(1 To UBound(SArr), 1 To 4)
For i = 1 To UBound(SArr)
SArr(i, 1) = Replace(SArr(i, 1), "-", "")
ReDim Nms(1 To 200)
Tmp = Split(SArr(i, 1))
For j = UBound(Tmp) - 2 To 1 Step -1
If Len(Tmp(j)) > Len(Tmp(j + 1)) Then
Res(i, 4) = Tmp(j + 1)
Exit For
End If
Next j
If Res(i, 4) = "" Then
For j = UBound(Tmp) - 2 To 1 Step -1
If IsNumeric(Tmp(j)) = False Then
If Len(Tmp(j + 1)) < 3 Then
Res(i, 4) = Tmp(j + 1)
Exit For
End If
Exit For
End If
Next j
End If
Res(i, 1) = Tmp(0)
For j = 1 To UBound(Tmp) - 1
If IsNumeric(Tmp(j)) = True Then Nms(Len(CStr(Val(Tmp(j))))) = j
Next j
Nms = Split(WorksheetFunction.Trim(Join(Nms)))
Res(i, 3) = Tmp(CLng(Nms(UBound(Nms))))
Res(i, 2) = Tmp(CLng(Nms(UBound(Nms) - 1)))
Next i
Sheet1.Range("B2", Sheet1.Range("E" & UBound(SArr) + 1)).ClearContents
Sheet1.Range("B2", Sheet1.Range("E" & UBound(SArr) + 1)) = Res
End SubDạ em cảm ơn anh chúc anh có nhiều sức khỏe để hoàn thành tốt cv đề tài em quá khó phải k anh?
Anh có thể hỗ trợ giúp em với，
Có lẽ bạn nên giải thích rõ ý nghĩa các thông số của 1 vài dòng dữ liệu thì bài sẽ dễ giải quyết hơn
Anh có thể nêu rõ cách làm như thế nào được không anh? Em cảm ơn anh nhiều!Tôi góp ý thôi: Với bảng dữ liệu kiểu CSDL này thì bạn nên quản lý bằng Table, dữ liệu nên kiểm soát bằng Data Validation. Còn code thì không biết
Em có đưa ví dụ cho Anh hiểu!
Anh ơi máy iPhone làm sao mở có định dạng VBA anh?
Dạ để em thay đổi lại, Em gặp trường hợp đó Em không biết phải làm sao, dữ liệu quái dị quá, Nên nhờ mọi người sữa code như thế nào?
"Sữa code" đọc lên cứ liên tưởng tới mấy loại nước cốt, thèm rỏ cả dzãi.
kết quả em cần là: 1/2 8935049005025 8935049005025 8 đó Anh tương ứng 4 cột
"Sữa code" đọc lên cứ liên tưởng tới mấy loại nước cốt, thèm rỏ cả dzãi.
Nghĩ một hồi mới ra cái bầu đựng "sữa code", hóa ra cái bầu này tên gọi là module
Ai ngờ bài đơn giản vậy mà nát óc mới ra.
Anh xem code Anh Befaint trường hợp đi lên đều đúng hết giờ trường hợp này code Anh Befaint nên thay đổi như thế nào mà không mất tất cả các trường hợp em đưa lên!
Spam tí cho nhẹ cái đầu í mà.
Anh có tài liệu học lập trình không gửi cho em với, em mới chập chững học VBA đó Anh?Spam tí cho nhẹ cái đầu í mà.
Thật vậy, chỉ là cho nhẹ cái đầu thôi, bù lại cả tuần vất vả.
Hình như dữ liệu của bạn lấy từ nhiều nguồn chứ không phải 1?
Dạ em lấy dữ liệu trên phần mềm PLANO à, phần mềm của em làm chung cả hệ thống luôn,
Kết quả chính xác luôn Anh ơi nhưng sao em đến dòng này co khi nó ra có khi nó không Anh ơi.
Anh Befaint giúp em lần này được không?
Tài liệu thì tìm trên diễn đàn, mất công tìm xa xôi cho mệt.
Dạ em đang tập đây anh có gì không hiểu em hỏi anh nhé!
Diễn đàn này có rất nhiều thành viên có thể hỗ trợ cho bạn. Tất nhiên trong đó có tui.
Em cảm ơn anh. Chúc anh cuối tuần vui vẻDiễn đàn này có rất nhiều thành viên có thể hỗ trợ cho bạn. Tất nhiên trong đó có tui.
Tất nhiên là câu hỏi cũng phải rõ ràng, không thì có lẽ rất nhiều hệ quả hoang tưởng đi kèm.
Cuối tuần vui vẻ!
