Tách hóa đơn và số tiền theo điều kiện. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

thinhnx22

Thành viên hoạt động
Tham gia
22/12/15
Bài viết
182
Được thích
38
Trong file đính kèm, mình cần tách số hóa đơn và số tiền. Các bạn xem và giúp mình kết quả như file, Cảm ơn các bạn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
Làm theo gợi ý của bác @HieuCD và bác @hpkhuong
PHP: 
Sub test()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long, Cll As Range
    
    For Each Cll In Sheet1.Range("D5", Sheet1.Range("D5").End(xlDown))
        Cll.Value = Replace(CStr(Cll.Formula), "=", "")
    Next Cll
    
    sArr() = Sheet1.Range("A5", Sheet1.Range("A5").End(xlDown)).Resize(, 4).Value
    
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(sArr(I, 4), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Làm theo gợi ý của bác @HieuCD và bác @hpkhuong
PHP: 
Sub test()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long, Cll As Range
   
    For Each Cll In Sheet1.Range("D5", Sheet1.Range("D5").End(xlDown))
        Cll.Value = Replace(CStr(Cll.Formula), "=", "")
    Next Cll
   
    sArr() = Sheet1.Range("A5", Sheet1.Range("A5").End(xlDown)).Resize(, 4).Value
   
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(sArr(I, 4), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Kết quả sau khi chạy thì cột D sheet NGUON "biến hình" luôn.
 
Upvote 0
vanthinh3101 đã viết:
Làm theo gợi ý của bác @HieuCD và bác @hpkhuong
PHP: 
Sub test()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long, Cll As Range
  
    For Each Cll In Sheet1.Range("D5", Sheet1.Range("D5").End(xlDown))
        Cll.Value = Replace(CStr(Cll.Formula), "=", "")
    Next Cll
  
    sArr() = Sheet1.Range("A5", Sheet1.Range("A5").End(xlDown)).Resize(, 4).Value
  
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(sArr(I, 4), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá vanthinh ơi! Nhưng mà chạy code xong thì bảng dữ liệu gốc phần sotien bị biến thành chuỗi
 
Upvote 0
Upvote 0
vanthinh3101 đã viết:
Để xử lý cái này thì có thể làm 1 cột phụ bên cạnh cột D.
Sau khi xong việc thì xóa cột phụ đi --> như vậy là dữ liệu gốc sẽ nguyên trạng
Nhấp chuột vào đây để mở rộng...
Cam ơn VanThinh và tất cả các bác đã giúp đỡ nhé. File dùng để đối chiếu so sánh nên dữ liệu nguồn biến dạng chút cũng không sao.
 
Upvote 0
Ba Tê đã viết:
Hổng làm cột phụ, để nguyên bảng nguồn vậy thử xem.
Nhấp chuột vào đây để mở rộng...
em đang nghĩ cách đây ạ.
Nếu cột phụ thì em làm như sau:
PHP: 
Sub test()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long
    Dim Rng As Range, Cll As Range
    
    Set Rng = Sheet1.Range("D5", Sheet1.Range("D5").End(xlDown))
    Rng.Offset(, 1) = Rng.Formula
    
    For Each Cll In Rng.Offset(, 1)
        Cll.Value = Replace(CStr(Cll.Formula), "=", "")
    Next Cll
    
    sArr() = Rng.Offset(, -3).Resize(, 5).Value
    Rng.Offset(, 1).EntireColumn.Delete
    Set Rng = Nothing
    
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(sArr(I, 5), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
    
    MsgBox "Done", vbInformation, "GPE"
End Sub
 
Upvote 0
vanthinh3101 đã viết:
em đang nghĩ cách đây ạ.
Nếu cột phụ thì em làm như sau:
PHP: 
Sub test()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long
    Dim Rng As Range, Cll As Range
   
    Set Rng = Sheet1.Range("D5", Sheet1.Range("D5").End(xlDown))
    Rng.Offset(, 1) = Rng.Formula
   
    For Each Cll In Rng.Offset(, 1)
        Cll.Value = Replace(CStr(Cll.Formula), "=", "")
    Next Cll
   
    sArr() = Rng.Offset(, -3).Resize(, 5).Value
    Rng.Offset(, 1).EntireColumn.Delete
    Set Rng = Nothing
   
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(sArr(I, 5), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
   
    MsgBox "Done", vbInformation, "GPE"
End Sub
Nhấp chuột vào đây để mở rộng...
Thử với cái này rồi chỉ dùng nó thôi.
PHP: 
sArr = Sheets("NGUON").Range("A5", Sheets("NGUON").Range("A5").End(xlDown)).Resize(, 4).Formula
 
Upvote 0
Ba Tê đã viết:
Thử với cái này rồi chỉ dùng nó thôi.
PHP: 
sArr = Sheets("NGUON").Range("A5", Sheets("NGUON").Range("A5").End(xlDown)).Resize(, 4).Formula
Nhấp chuột vào đây để mở rộng...
Thật là tuyệt vời, em có thêm 1 kiến thức mới.
Em cám ơn bác nhiều.
Mã: 
Sub test1()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long, Cll As Range
   
    sArr() = Sheet1.Range("A5", Sheet1.Range("A5").End(xlDown)).Resize(, 4).Formula
   
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(Replace(sArr(I, 4), "=", ""), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
   
    MsgBox "Done", vbInformation, "GPE"
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
vanthinh3101 đã viết:
Thật là tuyệt vời, em có thêm 1 kiến thức mới.
Mã: 
Sub test1()
    Dim sArr(), dArr(1 To 1000, 1 To 4), Tmp1, Tmp2
    Dim I As Long, J As Long, K As Long, Cll As Range
   
    sArr() = Sheet1.Range("A5", Sheet1.Range("A5").End(xlDown)).Resize(, 4).Formula
   
    For I = 1 To UBound(sArr, 1)
        If InStr(sArr(I, 1), ",") Then
            Tmp1 = Split(sArr(I, 1), ",")
            Tmp2 = Split(Replace(sArr(I, 4), "=", ""), "+")
            For J = 0 To UBound(Tmp1)
                K = K + 1
                dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
            Next J
        Else
            K = K + 1
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    Sheet2.Range("A5:D65000").ClearContents
    Sheet2.Range("A5").Resize(K, 4) = dArr
   
    MsgBox "Done", vbInformation, "GPE"
End Sub
Nhấp chuột vào đây để mở rộng...
Muốn gọn code, có thể bỏ lệnh "If" bằng cách thêm Delimiter vào trước chuổi
Mã: 
    For I = 1 To UBound(sArr, 1)
        Tmp1 = Split("," & sArr(I, 1), ",")
        Tmp2 = Split("+" & Replace(sArr(I, 4), "=", ""), "+")
        For J = 1 To UBound(Tmp1)
            K = K + 1
            dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
        Next J
    Next I
 
Upvote 0
HieuCD đã viết:
Muốn gọn code, có thể bỏ lệnh "If" bằng cách thêm Delimiter vào trước chuổi
Mã: 
    For I = 1 To UBound(sArr, 1)
        Tmp1 = Split("," & sArr(I, 1), ",")
        Tmp2 = Split("+" & Replace(sArr(I, 4), "=", ""), "+")
        For J = 1 To UBound(Tmp1)
            K = K + 1
            dArr(K, 1) = Tmp1(J): dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 3): dArr(K, 4) = Tmp2(J)
        Next J
    Next I
Nhấp chuột vào đây để mở rộng...
Em cám ơn bác đã chỉ bảo.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
In lặp lại nhiều dòng ở cuối các trang (1 người xem)
Trả lời
13
Đọc
368
Hoàng Tuấn 868
H
T
Cách cộng tổng chính xác nhất
Trả lời
6
Đọc
160
minhminh27
minhminh27
L
xin anh chị giúp em công thức tính tổng năm theo điều kiện ạ
Trả lời
6
Đọc
117
VetMini
V
K
Tạo mã thiết bị
Trả lời
10
Đọc
227
khoailang
K
C
Xin file lên thực đơn và định lượng món ăn cho suất ăn công nghiệp
Trả lời
0
Đọc
44
Chihuong_vp90
C
T
Lỗi Khi Mở File Excel
Trả lời
3
Đọc
90
Hoàng Tuấn 868
H
GPE-Trợ Lý
ĐĂNG KÍ THAM DỰ SINH NHẬT GPE TẠI HN - SỰ KIỆN TALKSHOW ĐẶC BIỆT (2 người xem)
    • Thích
2
Trả lời
23
Đọc
1K
PhanTuHuong
PhanTuHuong
H
Em chào anh chị ạ.Em cần xếp lịch nghỉ randum cho 1 số nhóm làm việc trong 1 công ty. (1 người xem)
Trả lời
4
Đọc
124
Duy Tùng 9x
Duy Tùng 9x
1
Em hỏi chút về hàm điều kiện với liệt kê
Trả lời
2
Đọc
129
123456it
1
M
File excel ứng dụng trong nhập xuất kho, thu chi, bán hàng và công nợ (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
7 8 9
Trả lời
165
Đọc
31K
quick87
quick87
chickenexcel
xin hướng dẫn code chọn hình ảnh trong file
Trả lời
2
Đọc
93
chickenexcel
chickenexcel
tramcannt
data validation (1 người xem)
Trả lời
2
Đọc
99
ptm0412
ptm0412
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit (1 người xem)
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
514
Đọc
204K
hoangtuan.net
hoangtuan.net
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
2 3
Trả lời
56
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
  • Dán lên cao
Sử dụng AI trong Excel với Add-in A-Tools AI v10
    • Thích
    • Cảm ơn
Trả lời
6
Đọc
812
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
Lỗi syntax error
Trả lời
2
Đọc
111
ptm0412
ptm0412
H
Xin các bác giúp đỡ cách đổi thời gian thành số thập phân
Trả lời
8
Đọc
155
huyphanthieu
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
361
Đọc
40K
NGUYEN THOA 123
NGUYEN THOA 123
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :) (1 người xem)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
tungnguyen_kt
tungnguyen_kt
Maithy46
Giúp mình về việc lập bảng theo dõi chi tiết, báo cáo sản lượng công đoạn trong ngành may mặc ạ (1 người xem)
Trả lời
4
Đọc
535
Maithy46
Maithy46
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom