tách chuổi, ghép số để có số tiền đúng (1 người xem)

[cachabu]

chào các anh chị

em có file này khi em lấy dữ liệu từ phần mềm xuống thì có 1 số dòng số tiền chưa đúng do số tiền của cột này có 1 đến 3 chữ số bị nhảy vào cột khác , em muốn lấy số tiền đúng nhưng không biết viết code thế nào .

các anh chị xem giúp em bài này(file đính kèm có ví dụ sẽ rõ hơn)

cám ơn

 

[VetMini]

(A) Bây giờ tôi diễn tả vấn đề, nếu thấy đúng thì làm tiếp qua bên giải thuật:

1. các số dùng dấu chấm thay vì dấu phẩy. Cái này dễ, chỉ cần đổi nó thành phẩy.
2. có tất cả 3 cột. Bất cứ ô nào cũng có thể là trống, là số hoặc là chữ.
2.1. nếu cột trước là số và cột kế đó là số thì chúng phải nối nhau.
vd: E4 trống, khỏi nối. Nhưng F4 sẽ nối với G4
2.1.1. Tuy trong dữ liệu không có hàng nào cả 3 cột đều có số, những vẫn phải đề phòng trường hợp này. Vì vậy phải ra luật ưu tiên từ trái qua phải, hễ cột bên trái nối rồi thì cột bên phải ráng chịu, không nối.
2.2. Luật nối: số bên trái đứng trước, số bên phải đứng sau
vd: E19(9,000,00) nối với F19(0) thành 9,000,000; F19 thành trống.
2.2.1. Nếu số bên phải có khoảng trống thì nó sẽ được cắt làm 2: phần trước nối vào số bên trái, phần sau để lại
vd: F4(10,126,01) nối với G4(6 8,805,602,263) --> G4 cắt làm 2 đem 6 nối với F4; và 8,805,602,263 để lại G4

 

[gtri]

chào các anh chị

em có file này khi em lấy dữ liệu từ phần mềm xuống thì có 1 số dòng số tiền chưa đúng do số tiền của cột này có 1 đến 3 chữ số bị nhảy vào cột khác , em muốn lấy số tiền đúng nhưng không biết viết code thế nào .

các anh chị xem giúp em bài này(file đính kèm có ví dụ sẽ rõ hơn)

cám ơn

Chạy thử đoạn code này xem thế nào

Public Sub NoiChuoi()
Dim Nguon, Tam, Kq() As String, d As Long, c As Long
Nguon = Sheet1.Range("E4", "G" & Sheet1.UsedRange.Rows.Count)
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))
Sheet3.UsedRange.Clear

With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.Pattern = "\.\d+$|\.$"

For d = 1 To UBound(Nguon, 1)
For c = 1 To UBound(Nguon, 2) - 1
If InStr(1, Nguon(d, c), ".", 1) Then
If Len(.Execute(Nguon(d, c))(0)) < 4 Then
If InStr(1, Nguon(d, c + 1), " ", 1) Then
Tam = Split(Application.Trim(Nguon(d, c + 1)), " ")
Kq(d, c) = Nguon(d, c) & Tam(0)
Kq(d, c + 1) = Tam(1)
ElseIf InStr(1, Nguon(d, c + 1), ".", 1) = 0 Then
Kq(d, c) = Nguon(d, c) & Nguon(d, c + 1)
Kq(d, c + 1) = ""
Else
Kq(d, c) = Nguon(d, c)
Kq(d, c + 1) = Nguon(d, c + 1)
End If
Else
Kq(d, c) = Nguon(d, c)
End If
End If
Next c
Next d

End With

Sheet3.Range("A1").Resize(UBound(Kq, 1), UBound(Kq, 2)).Value = Kq
End Sub

Thay dấu "." thành "," có lẽ sẽ làm thay đổi giá trị kết quả

 

[cachabu]

Chạy thử đoạn code này xem thế nào

Public Sub NoiChuoi()
Dim Nguon, Tam, Kq() As String, d As Long, c As Long
Nguon = Sheet1.Range("E4", "G" & Sheet1.UsedRange.Rows.Count)
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))
Sheet3.UsedRange.Clear

With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.Pattern = "\.\d+$|\.$"

For d = 1 To UBound(Nguon, 1)
For c = 1 To UBound(Nguon, 2) - 1
If InStr(1, Nguon(d, c), ".", 1) Then
If Len(.Execute(Nguon(d, c))(0)) < 4 Then
If InStr(1, Nguon(d, c + 1), " ", 1) Then
Tam = Split(Application.Trim(Nguon(d, c + 1)), " ")
Kq(d, c) = Nguon(d, c) & Tam(0)
Kq(d, c + 1) = Tam(1)
ElseIf InStr(1, Nguon(d, c + 1), ".", 1) = 0 Then
Kq(d, c) = Nguon(d, c) & Nguon(d, c + 1)
Kq(d, c + 1) = ""
Else
Kq(d, c) = Nguon(d, c)
Kq(d, c + 1) = Nguon(d, c + 1)
End If
Else
Kq(d, c) = Nguon(d, c)
End If
End If
Next c
Next d

End With

Sheet3.Range("A1").Resize(UBound(Kq, 1), UBound(Kq, 2)).Value = Kq
End Sub

Thay dấu "." thành "," có lẽ sẽ làm thay đổi giá trị kết quả

bạn ơi, về mặt cơ bản code của bạn đã tách và ghép số thành công , nhưng mình muốn kết quả trả về đúng các dòng tại sheet 1 luôn được ko bạn, và tất cả phải chuyển về thành dấu phẩy (",").
bạn giúp mình nhé
cám ơn

 

[VetMini]

@gtri

regex 1: bạn chỉ tìm số, vì vậy không cần phải ignorecase
regex 2: nếu đặt pattern "\.\d{0,2}$" (1 dấu chấm và từ 0 đến 2 chữ số) thì chỉ cần test, không cần phải lấy ra.

Thêm về giải thuật nối với ô thứ 2:
Có 2 cách, một là dùng regex để tách phần đầu, phần cuối.
hai là dùng hàm split. Trước khi split, cộng một dấu cách sau ô thứ 2 thì ta luôn luôn tách được ít nhất 2 chuỗi (tối thiểu phải có s(1); đem s(0) cộng vào ô thứ nhất và giữ s(1) lại cho ô thứ 2.

Về cách đặt dấu phẩy:
Trước khi ghi vào ô, dùng con toán format
ô = format(Val(replace(s,".","")), "#,###")

 

[cachabu]

@gtri

regex 1: bạn chỉ tìm số, vì vậy không cần phải ignorecase
regex 2: nếu đặt pattern "\.\d{0,2}$" (1 dấu chấm và từ 0 đến 2 chữ số) thì chỉ cần test, không cần phải lấy ra.

Thêm về giải thuật nối với ô thứ 2:
Có 2 cách, một là dùng regex để tách phần đầu, phần cuối.
hai là dùng hàm split. Trước khi split, cộng một dấu cách sau ô thứ 2 thì ta luôn luôn tách được ít nhất 2 chuỗi (tối thiểu phải có s(1); đem s(0) cộng vào ô thứ nhất và giữ s(1) lại cho ô thứ 2.

Về cách đặt dấu phẩy:
Trước khi ghi vào ô, dùng con toán format
ô = format(Val(replace(s,".","")), "#,###")

mình cũng ko rành nhiều về lập trình , nên có gì nhờ anh làm luôn trên file giúp em nhé, và sau khi tách và ghép xong chuổi thì trả kết quả trúng về chính các ô tại sheet 1 luôn được ko anh? dể tương ứng với ngày số chứng từ nào thì thể hiện số tiền đúng tại đó luôn

cám ơn

 

[gtri]

bạn ơi, về mặt cơ bản code của bạn đã tách và ghép số thành công , nhưng mình muốn kết quả trả về đúng các dòng tại sheet 1 luôn được ko bạn, và tất cả phải chuyển về thành dấu phẩy (",").
bạn giúp mình nhé
cám ơn

Bạn dùng code này xem đã đạt yêu cầu chưa

Public Sub NoiChuoi()
Dim Nguon, Tam, Kq() As String, d As Long, c As Long
Nguon = Sheet1.Range("E4", "G" & Sheet1.Range("A1000000").End(xlUp).Row)
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))

With CreateObject("VBScript.RegExp")
.Global = True

For d = 1 To UBound(Nguon, 1)
For c = 1 To UBound(Nguon, 2) - 1
.Pattern = "\.\d{3}$"
If .test(Nguon(d, c)) = True Or Nguon(d, c) = "" Then
Kq(d, c) = Nguon(d, c)
Kq(d, c + 1) = Nguon(d, c + 1)
Else
.Pattern = "\.\d{0,2}$"
If .test(Nguon(d, c)) = True Then
.Pattern = "\S+"
If .Execute(Nguon(d, c + 1)).Count > 1 Then
Kq(d, c) = Nguon(d, c) & .Execute(Nguon(d, c + 1))(0)
Kq(d, c + 1) = .Execute(Nguon(d, c + 1))(1)
Else
Kq(d, c) = Nguon(d, c) & Nguon(d, c + 1)
Kq(d, c + 1) = ""
End If
End If
End If

Next c
Next d
End With

Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2)).Clear
Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2)).Value = Kq

For Each Tam In Sheet3.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
If Tam <> "" Then
Tam.Value = Replace(Tam.Value, ".", "")
Tam.NumberFormat = "#,###"
End If
Next Tam

End Sub

---------
To VetMini :
Thank Những gợi ý của bạn!!!

 

[cachabu]

Bạn dùng code này xem đã đạt yêu cầu chưa

Public Sub NoiChuoi()
Dim Nguon, Tam, Kq() As String, d As Long, c As Long
Nguon = Sheet1.Range("E4", "G" & Sheet1.Range("A1000000").End(xlUp).Row)
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))

With CreateObject("VBScript.RegExp")
.Global = True

For d = 1 To UBound(Nguon, 1)
For c = 1 To UBound(Nguon, 2) - 1
.Pattern = "\.\d{3}$"
If .test(Nguon(d, c)) = True Or Nguon(d, c) = "" Then
Kq(d, c) = Nguon(d, c)
Kq(d, c + 1) = Nguon(d, c + 1)
Else
.Pattern = "\.\d{0,2}$"
If .test(Nguon(d, c)) = True Then
.Pattern = "\S+"
If .Execute(Nguon(d, c + 1)).Count > 1 Then
Kq(d, c) = Nguon(d, c) & .Execute(Nguon(d, c + 1))(0)
Kq(d, c + 1) = .Execute(Nguon(d, c + 1))(1)
Else
Kq(d, c) = Nguon(d, c) & Nguon(d, c + 1)
Kq(d, c + 1) = ""
End If
End If
End If

Next c
Next d
End With

Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2)).Clear
Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2)).Value = Kq

For Each Tam In Sheet3.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
If Tam <> "" Then
Tam.Value = Replace(Tam.Value, ".", "")
Tam.NumberFormat = "#,###"
End If
Next Tam

End Sub

---------
To VetMini :
Thank Những gợi ý của bạn!!!

code của bạn quá tuyệt , nhưng bạn ơi hình như nó chưa đổi sang dấu phẩy mình dung code nó vẫn nguyên dấu chấm xin cám ơn rất rất nhiều

 

[gtri]

code của bạn quá tuyệt , nhưng bạn ơi hình như nó chưa đổi sang dấu phẩy mình dung code nó vẫn nguyên dấu chấm xin cám ơn rất rất nhiều

Đọan này bị sai

For Each Tam In Sheet3.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
If Tam <> "" Then
Tam.Value = Replace(Tam.Value, ".", "")
Tam.NumberFormat = "#,###"
End If
Next Tam

-----------------------
Bạn dán đoạn này đè lên đoạn For Each -- Next trên là ổn

With Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
.Cells.SpecialCells(xlCellTypeConstants).Replace what:=".", replacement:=""
.Cells.SpecialCells(xlCellTypeConstants).NumberFormat = "#,###"
End With

Bẫy lỗi cho code bạn chủ động xử lý nha

 

[cachabu]

Đọan này bị sai

For Each Tam In Sheet3.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
If Tam <> "" Then
Tam.Value = Replace(Tam.Value, ".", "")
Tam.NumberFormat = "#,###"
End If
Next Tam

-----------------------
Bạn dán đoạn này đè lên đoạn For Each -- Next trên là ổn

With Sheet1.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
.Cells.SpecialCells(xlCellTypeConstants).Replace what:=".", replacement:=""
.Cells.SpecialCells(xlCellTypeConstants).NumberFormat = "#,###"
End With

Bẫy lỗi cho code bạn chủ động xử lý nha

cám ơn bạn nhìu lắm
có 1 điều nữa lúc mình làm file ví dụ không lường trước đên trường hợp này là trường hợp nếu như số trong cột E không có dấu chấm thì code của bạn nó tự động làm mất luôn số đó, ví dụ mình nhập số 1 hoặc 11 hoặc 111 thì lúc chạy code nó mất luôn, như vậy số tiền bị sai vậy bạn có cách nào làm cho nó đừng mất số và giữ nguyên được ko?
có thể hiểu như vậy: nếu số trong cột E ko có dấu chấm và cột F = trống thì giữ nguyên số tại cột E hoặc cách khác nếu cột E có số là ko có dấu chấm thì sẻ thêm cho nó cai dấu chấm phía sau , sau đó chạy code của bạn.
mình chỉ hiểu đại loại như vậy nhưng code thì minh hạn chế, bạn có cách viết nào khác hơn thì viêt giúp mình đoạn này nữa nhé
tiếp theo giả sử mình muốn viết thêm câu lệnh nếu như tất cả 3 cột đã chuyển sang dạng số hết rồi thì không phải làm gì cả còn ngược lại thì sẻ relace thành dấu phẩy thì viết code thế nào vậy bạn?
bạn giúp luôn mình cái này nhé'
cám ơn

 

[Quang_Hải]

chào các anh chị

em có file này khi em lấy dữ liệu từ phần mềm xuống thì có 1 số dòng số tiền chưa đúng do số tiền của cột này có 1 đến 3 chữ số bị nhảy vào cột khác , em muốn lấy số tiền đúng nhưng không biết viết code thế nào .

các anh chị xem giúp em bài này(file đính kèm có ví dụ sẽ rõ hơn)

cám ơn

Thử kiểu code này. Code có ngắn được chút nhưng kết quả không chắc lắm.

Sub tien()
Dim data(), i&, n&, j&
data = Range([A4], [A65536].End(3)).Offset(, 4).Resize(, 3).Value
For i = 1 To UBound(data)
   For j = 1 To 2
      If data(i, j) <> "" Then
         n = InStr(Right(data(i, j), 3), ".")
         If n > 0 Then
            data(i, j) = data(i, j) & Left(data(i, j + 1), n)
            If Len(data(i, j + 1)) = n Then
               data(i, j + 1) = Empty
            Else
              data(i, j + 1) = Right(data(i, j + 1), Len(data(i, j + 1)) - n)
            End If
         End If
      End If
   Next
   For j = 1 To 3
      data(i, j) = Application.Trim(Replace(data(i, j), ".", ""))
   Next
Next
[E4].Resize(i - 1, 3).NumberFormat = "#,###"
[E4].Resize(i - 1, 3) = data
End Sub

Có thể dùng Range.Replace nên không cần dùng vòng lặp làm gì nhé

For Each Tam In Sheet3.Range("E4").Resize(UBound(Kq, 1), UBound(Kq, 2))
  If Tam <> "" Then
   Tam.Value = Replace(Tam.Value, ".", "")
   Tam.NumberFormat = "#,###"
  End If
Next Tam
End Sub

 

[cachabu]

Thử kiểu code này. Code có ngắn được chút nhưng kết quả không chắc lắm.

Sub tien()
Dim data(), i&, n&, j&
data = Range([A4], [A65536].End(3)).Offset(, 4).Resize(, 3).Value
For i = 1 To UBound(data)
   For j = 1 To 2
      If data(i, j) <> "" Then
         n = InStr(Right(data(i, j), 3), ".")
         If n > 0 Then
            data(i, j) = data(i, j) & Left(data(i, j + 1), n)
            If Len(data(i, j + 1)) = n Then
               data(i, j + 1) = Empty
            Else
              data(i, j + 1) = Right(data(i, j + 1), Len(data(i, j + 1)) - n)
            End If
         End If
      End If
   Next
   For j = 1 To 3
      data(i, j) = Application.Trim(Replace(data(i, j), ".", ""))
   Next
Next
[E4].Resize(i - 1, 3).NumberFormat = "#,###"
[E4].Resize(i - 1, 3) = data
End Sub

Có thể dùng Range.Replace nên không cần dùng vòng lặp làm gì nhé

cám ơn anh quang hải, code dùng ok