Chuyển từ NKSC ->NKC!

[ThuNghi]

Các bạn viết hộ Code chuyển từ NKSC ->NKC theo file kèm, hay là giúp 1 thuật toán. Xin cám ơn!

 

[ptm0412]

Chuyển sang 1 nợ 1 có trước đi Thunghi. nếu được 1 nợ 1 có xài công thức là xong.
Có file thí dụ
Không được chắc phải VBA!
Để về nhà nghĩ tiếp!
---------
nghĩ hoài không ra!

 

[ThuNghi]

Chắc phải thêm điều kiện chỉ là 1 Nợ 2 Có hay là 2 Nợ 1 Có
Tôi đã làm thử nhưng vướng ở chỗ
ĐK:
Có 334 Nợ 641: 10.000
Có 334 Nợ 642: 10.000
ie số tiền bằng nhau thì lúng túng quá.
Các bạn xem và góp ý nhé.
Xin cám ơn!

 

[ptm0412]

Đi đường vòng nhé!
Đổi giá trị cell có giá trị bằng St2 thành ST2 + 0.001 rồi sau đó trả lại.

If iC > 2 Then
Rows(i).Insert Shift:=xlDown  
Range("A" & i & ":BR" & i).Value = Range("A" & i + 1 & ":BR" & i + 1).Value '
For x = 1 To ECol  '
 
     ST1 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 3) 
     ST2 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 2)  
     ST3 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 1) '
      If Cells(i, FCol + x) = ST2 Then
             Cells(i, FCol + x) = ST2 + 0.001 
             ST2 = ST2 + 0.001
      End If
Next x '
                        Cells(i, 5) = ST2 - 0.001 
                        Cells(i + 1, 5) = ST3 
                            For j = 1 To ECol 
                                If Cells(i, j + FCol) > 0 Then
                                    Select Case Cells(i, j + FCol)
                                        Case ST3
                                            Cells(i, j + FCol) = ""
                                            Cells(i + 1, j + FCol) = ST3
                                        Case ST2
                                            Cells(i + 1, j + FCol) = ""
                                            Cells(i, j + FCol) = ST2 - 0.001
                                        Case ST1
                                            Cells(i, j + FCol) = ST2 - 0.001
                                            Cells(i + 1, j + FCol) = ST3
                                        End Select
                                End If
                            Next j
                            ST1 = 0
                            ST2 = 0
                            ST3 = 0
                    End If

Đoạn màu đỏ làm thêm vào.
Đoạn dưới có thêm những " - 0,001" ở sau dòng nào có ST2

 

[ptm0412]

Lỡ xài Excel Function rồi thì xài tới luôn!
Không dùng For Next nữa mà gán trực tiếp :

ST1 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 3) 
ST2 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 2)  
ST3 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 1) 
 
 
VitriST2 = WorksheetFuntion.Match(ST2, Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 0)
Cells(i, FCol + VitriST2) = ST2 + 0.001
ST2 = ST2 +0.001

Đường vòng này so với đường thẳng thế nào các bạn?

 

[ThuNghi]

Lỡ xài Excel Function rồi thì xài tới luôn!
Không dùng For Next nữa mà gán trực tiếp :

ST1 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 3) 
ST2 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 2)  
ST3 = WorksheetFunction.Small(Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 1) 
 
 
VitriST2 = WorksheetFuntion.Match(ST2, Range(Cells(i, FCol + 1), Cells(i, FCol + ECol)), 0)
Cells(i, FCol + VitriST2) = ST2 + 0.001
ST2 = ST2 +0.001

Đường vòng này so với đường thẳng thế nào các bạn?

Vận dụng bài trên của PTM0412 mình đã sửa code lại, các bạn góp ý thêm.
To Ptm0412: Dùng Match thì OK nhưng không nên + 0.001, dữ liệu thường lấy là có sổ lẻ. Bác xem em vận dụng thử có OK?

 

[ptm0412]

Ra kết quả dĩ nhiên là OK. Nhưng hình như khó phát triển thêm thành 1 nợ 3, 4 có hoặc 1 có 3, 4 nợ.
Không cộng 0.001 thì cộng 1 hoặc nhân 1.000 sau đó chia ra lại (hoặc bất kỳ phép toán nào). Cái chính là tạo 1 trung gian.
Thứ hai là khả năng mở rộng ra 1 có 3, 4 nợ.
MÀ SỐ LẺ HAY NGUYÊN, CỘNG VÀO RỒI TRỪ RA CÓ HỀ GÌ?

 

[minhlev]

Em xin phép được nói leo tí chút. Thôi không nói nữa, vì sợ nói nhiều thành rối rắm ra. Em xin gửi lên cái file chuyển đổi từ NKSC->NKC. File này dựa trên cơ sở file của 2 bác ThuNghi và ptm0412. File có thể lấy được 1 nợ nhiều có hoặc nhiều nợ 1 có. Đây mới là file thô, nhờ các bác xem và chỉnh sửa dùm.

 

[ptm0412]

Mình cũng nghĩ đến thuật toán For Next gán giá trị theo Count(Sotien) để mở rộng 1 nợ nhiều có hoặc 1 có nhiều nợ, nhưng đang lúng túng về biến Vitri. Nếu 1 n nhiều c thì Vitri phải là biến mảng không xác định trước số phần tử và Redim khi tính được count(Sotien).
Nhưng Minhlev giải quyết còn hay hơn. Thuật toán hay hơn, chỉ cần 1 vitri Max(sotien), không quan tâm số tiền bằng nhau.
code vì thế gọn hơn. Tuyệt!

TB: Xài Excel Function tới luôn!