Hỗ trợ phép toàn trừ giữ nguyên định dạng

Liên hệ QC
Tình nghĩa giang hồ

Tình nghĩa giang hồ

Thanh sơn bất cải, lục thủy trường lưu
Tham gia
29/9/20
Bài viết
330
Được thích
429
Chào anh chị.
Do dữ liệu em lấy từ phần mềm ra. Nên số âm nó quy định dấu - ở bên phải.
Giờ em muốn thực hiện phép trừ cho phép tính này. Nhưng em mong muốn kết quả ra thì dấu trừ vẫn ở bên phải, để so sánh với phần mềm.
Cột thực hiện phép trừ của em là cột H - cho cột I.
Em cảm ơn anh chị.
 

File đính kèm

Chào anh chị bài này em giải chống chế bằng công thức
Cột J2 =IF(RIGHT(H2,1)="-",(SUBSTITUTE(H2,"-","")-SUBSTITUTE(I2,"-",""))&"-",H2-I2)

Hoặc VBA

Sub phep_tru()
lr = Sheet1.Range("H" & Rows.Count).End(xlUp).Row
Sheet1.Range("J2").Formula = "=IF(RIGHT(RC[-2],1)=""-"",(SUBSTITUTE(RC[-2],""-"","""")-SUBSTITUTE(RC[-1],""-"",""""))&""-"",RC[-2]-RC[-1])"

Sheet1.Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J" & lr), Type:=xlFillDefault
Sheet1.Range("J2:J" & lr) = Sheet1.Range("J2:J" & lr).Value
End Sub

Nhưng cách này em thấy không ổn lắm,
Nếu viết bằng mảng mà không dùng công thức thì làm như thế nào anh chị.
Nhờ anh chị hỗ trợ giúp.
Em cảm ơn
 
Tình nghĩa giang hồ đã viết:
Chào anh chị.
Do dữ liệu em lấy từ phần mềm ra. Nên số âm nó quy định dấu - ở bên phải.
Giờ em muốn thực hiện phép trừ cho phép tính này. Nhưng em mong muốn kết quả ra thì dấu trừ vẫn ở bên phải, để so sánh với phần mềm.
Cột thực hiện phép trừ của em là cột H - cho cột I.
Em cảm ơn anh chị.
Nhấp chuột vào đây để mở rộng...
Thử công thức tại J2 (Nếu máy phân cách hàng ngàn không phải là dấu "," thì dài hơn xíu):
Mã: 
=TEXT(SUMPRODUCT(TEXT(--(RIGHT(H2:I2)="-"),"[=0]\1;-1")*SUBSTITUTE(H2:I2,"-","")*{1,-1}),"#,#;#,#-")
 
Tình nghĩa giang hồ đã viết:
Chào anh chị bài này em giải chống chế bằng công thức
Cột J2 =IF(RIGHT(H2,1)="-",(SUBSTITUTE(H2,"-","")-SUBSTITUTE(I2,"-",""))&"-",H2-I2)

Hoặc VBA

Sub phep_tru()
lr = Sheet1.Range("H" & Rows.Count).End(xlUp).Row
Sheet1.Range("J2").Formula = "=IF(RIGHT(RC[-2],1)=""-"",(SUBSTITUTE(RC[-2],""-"","""")-SUBSTITUTE(RC[-1],""-"",""""))&""-"",RC[-2]-RC[-1])"

Sheet1.Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J" & lr), Type:=xlFillDefault
Sheet1.Range("J2:J" & lr) = Sheet1.Range("J2:J" & lr).Value
End Sub

Nhưng cách này em thấy không ổn lắm,
Nếu viết bằng mảng mà không dùng công thức thì làm như thế nào anh chị.
Nhờ anh chị hỗ trợ giúp.
Em cảm ơn
Nhấp chuột vào đây để mở rộng...
Mình góp vui bằng code thế này (đúng phương trâm 1+1 =2) nhá.
Bạn thử kiểm tra lại xem nhé!
PHP: 
Option Explicit
Sub GPE()
    Dim Lr&, i&, Arr(), Res(), a&, b&, k&
    With Sheets("Sheet1")
        Lr = .Range("H" & Rows.Count).End(xlUp).Row
        Arr = .Range("H2:I" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            k = k + 1
            a = InStr(Arr(i, 1), "-")
            b = InStr(Arr(i, 2), "-")
            If a = 0 And b = 0 Then
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = Arr(i, 1) - Arr(i, 2)
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
            End If
            ElseIf a = 0 And b > 0 Then
            Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                    Res(k, 1) = Arr(i, 1) + Arr(i, 2)
            ElseIf a > 0 And b > 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = Arr(i, 2) - Arr(i, 1)
                End If
            ElseIf a > 0 And b = 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                End If
            End If
        Next i
        If k Then
            .Range("J2:J10000").ClearContents
            .Range("J2").Resize(k, 1).Value = Res
        End If
    End With
    MsgBox "Xong roi"
End Sub
 
Lần chỉnh sửa cuối:
Zl: 0933707265 đã viết:
Mình góp vui bằng code thế này (đúng phương trâm 1+1 =2) nhá.
Bạn thử kiểm tra lại xem nhé!
PHP: 
Option Explicit
Sub GPE()
    Dim Lr&, i&, Arr(), Res(), a&, b&, k&
    With Sheets("Sheet1")
        Lr = .Range("H" & Rows.Count).End(xlUp).Row
        Arr = .Range("H2:I" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            k = k + 1
            a = InStr(Arr(i, 1), "-")
            b = InStr(Arr(i, 2), "-")
            If a = 0 And b = 0 Then
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = Arr(i, 1) - Arr(i, 2)
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
            End If
            ElseIf a = 0 And b > 0 Then
                Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = Arr(i, 1) - Arr(i, 2)
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
            End If
            ElseIf a > 0 And b > 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                End If
            ElseIf a > 0 And b = 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                End If
            End If
        Next i
        If k Then
            .Range("J2:J10000").ClearContents
            .Range("J2").Resize(k, 1).Value = Res
        End If
    End With
    MsgBox "Xong roi"
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhiều.
 
Zl: 0933707265 đã viết:
Mình góp vui bằng code thế này (đúng phương trâm 1+1 =2) nhá.
Bạn thử kiểm tra lại xem nhé!
PHP: 
Option Explicit
Option Explicit
Sub GPE()
    Dim Lr&, i&, Arr(), Res(), a&, b&, k&
    With Sheets("Sheet1")
        Lr = .Range("H" & Rows.Count).End(xlUp).Row
        Arr = .Range("H2:I" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            k = k + 1
            a = InStr(Arr(i, 1), "-")
            b = InStr(Arr(i, 2), "-")
            If a = 0 And b = 0 Then
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = Arr(i, 1) - Arr(i, 2)
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
            End If
            ElseIf a = 0 And b > 0 Then
            Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                    Res(k, 1) = Arr(i, 1) + Arr(i, 2)
            ElseIf a > 0 And b > 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                Arr(i, 2) = Left(Arr(i, 2), b - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                End If
            ElseIf a > 0 And b = 0 Then
                Arr(i, 1) = Left(Arr(i, 1), a - 1) * 1
                If Arr(i, 1) >= Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                ElseIf Arr(i, 1) < Arr(i, 2) Then
                    Res(k, 1) = (Arr(i, 1) - Arr(i, 2)) & "-"
                End If
            End If
        Next i
        If k Then
            .Range("J2:J10000").ClearContents
            .Range("J2").Resize(k, 1).Value = Res
        End If
    End With
    MsgBox "Xong roi"
End Sub
Nhấp chuột vào đây để mở rộng...
Chưa có đọc nhưng mà sao dài ghê vậy bạn hihi
 
Thêm cách khác tham khảo
Mã: 
Sub ABC()
    Dim sArr(), Res(), i&, CotH As Double, CotI As Double
    With Sheets("Sheet1")
        sArr = .Range("H2:I15").Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
           CotH = iif(InStr(sArr(i, 1), "-"), "-" & Replace(sArr(i, 1), "-", ""), sArr(i, 1))
           CotI = iif(InStr(sArr(i, 2), "-"), "-" & Replace(sArr(i, 2), "-", ""), sArr(i, 2))
           Res(i, 1) = CotH - CotI
           If Res(i, 1) < 0 Then Res(i, 1) = Abs(Res(i, 1)) & "-"
        Next
        .Range("J2").Resize(UBound(sArr)).Value = Res
    End With
End Sub
 
Mệt.
Nhiều phần mềm theo định dạng cũ của Kế toán là dấu trừ nằm bên phải (nếu số dương thì là một dấu cách.)
Dùng Text-to-columns hay flash fill là xong.
 
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

GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
Trả lời
0
Đọc
1
GPE-Trợ Lý
GPE-Trợ Lý
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
2
Đọc
95
phatnguyen7301
phatnguyen7301
B
Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.
Trả lời
11
Đọc
435
bipbo2008
B
HeSanbi
  • Question Question
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
2
Đọc
187
HeSanbi
HeSanbi
NguyenthiH
Sao dùng Ctl + H thay thế không đúng.
Trả lời
19
Đọc
247
NguyenthiH
NguyenthiH
N
Lỗi định dạng số Excel 2019 - Nguyên nhân và cách khắc phục
Trả lời
1
Đọc
33
ptm0412
ptm0412
huuthang_bd
Chia sẻ: Tạo thông báo nhắc nhở khi sắp đến ngày kỷ niệm
    • Thích
    • Yêu thích
2
Trả lời
39
Đọc
9K
ngocminhkte
ngocminhkte
P
Tại sao khi đánh số thì bị mất hai số cuối
Trả lời
3
Đọc
18K
Nguyenlong2608
N
G
Chuyển Data từ hàng và cột về dạng cột
Trả lời
6
Đọc
88
Duy Tùng 9x
Duy Tùng 9x
HeSanbi
  • Đã giải quyết
ExcelController - Các hàm thực thi tác vụ linh hoạt cho Excel
    • Thích
Trả lời
5
Đọc
1K
HeSanbi
HeSanbi
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
10
Đọc
222
HUONGHCKT
H
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
10
Đọc
225
hvnhpro
H
tuv8x
Xin hỏi cách giới hạn vùng làm việc
Trả lời
2
Đọc
79
tuv8x
tuv8x
gamo_excel
Hàm Index trả về nhiều kết quả
Trả lời
12
Đọc
1K
VetMini
V
N
tắt bảo vệ trang tính
Trả lời
2
Đọc
68
ngọcanh@123
N
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
33
Đọc
12K
tnson1
tnson1
X
Đường lưới trong file excel bị mất
Trả lời
11
Đọc
8K
GREEN HOTEL CO
GREEN HOTEL CO
C
Tìm dữ liệu khác nhau trong 2 file hoặc 2 sheet trong excel
Trả lời
1
Đọc
81
vanle33
vanle33
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
23
Đọc
1K
CHAOQUAY
C
T
Game xóc đĩa trên excel
    • Cười
Trả lời
11
Đọc
2K
SA_DQ
SA_DQ
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom