nhờ các anh chị viết code thêm dữ liệu vào dòng cuối cùng của sheet khác

Liên hệ QC
A

acmen87

Thành viên chính thức
Tham gia
7/5/09
Bài viết
70
Được thích
6
Em đang lập file excel như sau: sheet CHENH LECH là để thực hiện các thao tác, sheet CHUYEN KHOAN và TIEN MAT là các sheet lưu trữ dữ liệu.
Xin phép nhờ mọi người viết giúp em code để thêm mới mã đơn vị và tên đơn vị từ sheet CHENH LECH sang 2 sheet lưu trữ dữ liệu với điều kiện như sau:
+ Dữ liệu tại ô I9 và I10 sẽ được cập nhật sang 2 sheet CHUYEN KHOAN và TIEN MAT với điều kiện như sau:
- Nếu ô I8 là CHUYEN KHOAN thì dữ liệu I9 và I10 được thêm sang sheet CHUYEN KHOAN, nếu là TIEN MAT thì thêm sang sheet TIEN MAT
- Tại mỗi sheet dữ liệu là CHUYEN KHOAN hoặc TIEN MAT, sẽ kiểm tra theo mã ĐVQHNS tại ô I9 với các dữ liệu hiện có tại cột B của sheet (bắt đầu từ B7 trở đi), nếu đã có mã đó, thông báo lỗi "Mã ĐVQHNS" đã tồn tại, nếu chưa có thêm dữ liệu vào dòng cuối cùng chưa có dữ liệu trong 2 cột B và C trong đó: I9 là cột B, I10 là cột C

Em cảm ơn ạ
 

File đính kèm

  • Theo doi bien dong luong - Copy.xls
    92.5 KB · Đọc: 12
Sắp xếp theo thời gian sắp xếp theo bầu chọn
acmen87 đã viết:
Em đang lập file excel như sau: sheet CHENH LECH là để thực hiện các thao tác, sheet CHUYEN KHOAN và TIEN MAT là các sheet lưu trữ dữ liệu.
Xin phép nhờ mọi người viết giúp em code để thêm mới mã đơn vị và tên đơn vị từ sheet CHENH LECH sang 2 sheet lưu trữ dữ liệu với điều kiện như sau:
+ Dữ liệu tại ô I9 và I10 sẽ được cập nhật sang 2 sheet CHUYEN KHOAN và TIEN MAT với điều kiện như sau:
- Nếu ô I8 là CHUYEN KHOAN thì dữ liệu I9 và I10 được thêm sang sheet CHUYEN KHOAN, nếu là TIEN MAT thì thêm sang sheet TIEN MAT
- Tại mỗi sheet dữ liệu là CHUYEN KHOAN hoặc TIEN MAT, sẽ kiểm tra theo mã ĐVQHNS tại ô I9 với các dữ liệu hiện có tại cột B của sheet (bắt đầu từ B7 trở đi), nếu đã có mã đó, thông báo lỗi "Mã ĐVQHNS" đã tồn tại, nếu chưa có thêm dữ liệu vào dòng cuối cùng chưa có dữ liệu trong 2 cột B và C trong đó: I9 là cột B, I10 là cột C

Em cảm ơn ạ
Nhấp chuột vào đây để mở rộng...
Bạn thử dùng code sau:
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        End If
    End With
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Bạn thử dùng code sau:
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ mình đã thử và code chạy tốt bạn ạ. Cảm ơn bạn nhiều nhé
 
Upvote 0
vanthinh3101 đã viết:
Bạn thử dùng code sau:
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi, có một chút vấn đề là. Ban đâu mình thiết kế thì mình có để công thức ở I10 để excel tự dò tìm theo giá trị I9 cho ra tên đơn vị theo mã ĐVQHNS tương ứng. Tuy nhiên nếu dùng code bên trên nó sẽ bị mất công thức ở I10, có cách nào kết hợp 2 cái này không ạ?
Mình đã nghĩ tới cách tách 2 ô tên đơn vị riêng biệt. Tuy nhiên, Nếu như tách ra 2 ô tên đơn vị để 1 ô dò tìm, 1 ô dùng để thêm mới đơn vị thì sẽ phát sinh 2 ô giống nhau trong 1 bảng.
Bạn có thể giúp mình viết code: Chỉ cần nhập giá trị I9, Dò tìm I9 trong 2 cột B ở sheet tương ứng với giá trị tại I8, nếu đã tồn tại thì cho ra tên Đơn vị tương ứng ở cột C, nếu chưa có giá trị ở I9 thì hiện bảng cho phép nhập vào tên đơn vị quan hệ ngân sách và thêm giá trị I9 và tên đơn vị vừa nhập vào vào dòng cuối cùng của sheet tương ứng.
Em cảm ơn ạ
 
Lần chỉnh sửa cuối:
Upvote 0
acmen87 đã viết:
Bạn ơi, có một chút vấn đề là. Ban đâu mình thiết kế thì mình có để công thức ở I10 để excel tự dò tìm theo giá trị I9 cho ra tên đơn vị theo mã ĐVQHNS tương ứng. Tuy nhiên nếu dùng code bên trên nó sẽ bị mất công thức ở I10, có cách nào kết hợp 2 cái này không ạ?
Mình đã nghĩ tới cách tách 2 ô tên đơn vị riêng biệt. Tuy nhiên, Nếu như tách ra 2 ô tên đơn vị để 1 ô dò tìm, 1 ô dùng để thêm mới đơn vị thì sẽ phát sinh 2 ô giống nhau trong 1 bảng.
Bạn có thể giúp mình viết code: Chỉ cần nhập giá trị I9, Dò tìm I9 trong 2 cột B ở sheet tương ứng với giá trị tại I8, nếu đã tồn tại thì cho ra tên Đơn vị tương ứng ở cột C, nếu chưa có giá trị ở I9 thì hiện bảng cho phép nhập vào tên đơn vị quan hệ ngân sách và thêm giá trị I9 và tên đơn vị vừa nhập vào vào dòng cuối cùng của sheet tương ứng.
Em cảm ơn ạ
Nhấp chuột vào đây để mở rộng...
Bạn sửa lại thế này xem có ổn không?
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Bạn sửa lại thế này xem có ổn không?
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã trả lời, mình đã thử theo code của bạn. Tuy nhiên khi chạy code này thì mình thử nhập một mã cũ đã có trong sheet vào I9 thì tự động thêm mã đó vào dòng cuối của sheet tương ứng và không có tên đơn vị. Sau đó I 10 sẽ hiện lên #N/A. Nếu để nguyên như vậy và ấn code chạy 1 lần nữa thì sẽ báo lỗi. Còn nếu để mã cũ vừa được thêm vào và xóa I10 thì nó sẽ báo mã đã tồn tại
 
Upvote 0
acmen87 đã viết:
Cảm ơn bạn đã trả lời, mình đã thử theo code của bạn. Tuy nhiên khi chạy code này thì mình thử nhập một mã cũ đã có trong sheet vào I9 thì tự động thêm mã đó vào dòng cuối của sheet tương ứng và không có tên đơn vị. Sau đó I 10 sẽ hiện lên #N/A. Nếu để nguyên như vậy và ấn code chạy 1 lần nữa thì sẽ báo lỗi. Còn nếu để mã cũ vừa được thêm vào và xóa I10 thì nó sẽ báo mã đã tồn tại
Nhấp chuột vào đây để mở rộng...
Mình chưa hiểu ý của bạn lắm.
Nếu bạn nhập mã cũ, ô I10 sẽ tự động ra thông tin tên đơn vị.
Nếu bạn nhập mã mới, ô I10 sẽ hiện #N/A#, lúc này bạn tự nhập tay tên đơn vị mới sau đó chạy code là được mà.
 
Upvote 0
vanthinh3101 đã viết:
Mình chưa hiểu ý của bạn lắm.
Nếu bạn nhập mã cũ, ô I10 sẽ tự động ra thông tin tên đơn vị.
Nếu bạn nhập mã mới, ô I10 sẽ hiện #N/A#, lúc này bạn tự nhập tay tên đơn vị mới sau đó chạy code là được mà.
Nhấp chuột vào đây để mở rộng...
đang sai ở chỗ là dù là mã cũ nó vẫn hiện tên đơn vị vào i10, đồng thời nó chỉ thêm mã đơn vị vào cuối bảng bạn ạ. Còn nếu như nhập mã mới, ô I10 sẽ hiện #N/A#, lúc này tự nhập tay tên đơn vị mới sau đó chạy code thì sẽ bị mất công thức ở I10 bạn ạ
 
Lần chỉnh sửa cuối:
Upvote 0
acmen87 đã viết:
đang sai ở chỗ là dù là mã cũ nó vẫn hiện tên đơn vị vào i10, đồng thời nó chỉ thêm mã đơn vị vào cuối bảng bạn ạ. Còn nếu như nhập mã mới, ô I10 sẽ hiện #N/A#, lúc này tự nhập tay tên đơn vị mới sau đó chạy code thì sẽ bị mất công thức ở I10 bạn ạ
Nhấp chuột vào đây để mở rộng...
tớ gửi lại bạn cả file, bạn kiểm tra lại xem.
Chắc có thể do bạn chưa thay công thức mới cho I10 ngay ban đầu.
 

File đính kèm

  • Theo doi bien dong luong - Copy.xls
    108 KB · Đọc: 7
Upvote 0
acmen87 đã viết:
bạn cho mình hỏi công thức "=OFFSET('CHUYEN KHOAN'!B7;;;COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000);2)" ở B1 sheet 2 có thể xóa đi k ạ
Nhấp chuột vào đây để mở rộng...
Xóa được bạn nhé!
Mình viết nháp thử công thức lên đó thôi, bạn xóa đi, không ảnh hưởng gì đâu.
 
Upvote 0
vanthinh3101 đã viết:
Xóa được bạn nhé!
Mình viết nháp thử công thức lên đó thôi, bạn xóa đi, không ảnh hưởng gì đâu.
Nhấp chuột vào đây để mở rộng...
Bạn ơi, bạn giúp mình chút, công thức hôm qua mình thử lại chạy đúng rồi, nhưng mà nếu như mình xóa hết các mã đơn vị đã có ở 2 sheet CHUYEN KHOAN và TIEN MAT đi và chạy công thức thì báo lỗi bạn ạ. Mình gửi kèm hình nhé
 

File đính kèm

  • Untitled.jpg
    Untitled.jpg
    327 KB · Đọc: 5
Upvote 0
acmen87 đã viết:
Bạn ơi, bạn giúp mình chút, công thức hôm qua mình thử lại chạy đúng rồi, nhưng mà nếu như mình xóa hết các mã đơn vị đã có ở 2 sheet CHUYEN KHOAN và TIEN MAT đi và chạy công thức thì báo lỗi bạn ạ. Mình gửi kèm hình nhé
Nhấp chuột vào đây để mở rộng...
Code mình viết có điều kiện so sánh dựa trên cả mã và tên đơn vị.
Khi bạn xóa đi, tất nhiên nó sẽ báo lỗi.
 
Upvote 0
vanthinh3101 đã viết:
Code mình viết có điều kiện so sánh dựa trên cả mã và tên đơn vị.
Khi bạn xóa đi, tất nhiên nó sẽ báo lỗi.
Nhấp chuột vào đây để mở rộng...
Mình vừa thử thì phải có kín hết dữ liệu đến dòng cuối cùng mà mình đã kẻ trong mỗi sheet thì nó mới không báo lỗi, bạn có thể sửa giúp mình cái này được không? Do bên mình thường xuyên thay đổi đơn vị mình muốn code đó có thể dùng đc từ lúc chưa có dữ liệu và đến sau này có dữ liệu thì có thể thêm bớt dễ hơn
 
Upvote 0
acmen87 đã viết:
Mình vừa thử thì phải có kín hết dữ liệu đến dòng cuối cùng mà mình đã kẻ trong mỗi sheet thì nó mới không báo lỗi, bạn có thể sửa giúp mình cái này được không? Do bên mình thường xuyên thay đổi đơn vị mình muốn code đó có thể dùng đc từ lúc chưa có dữ liệu và đến sau này có dữ liệu thì có thể thêm bớt dễ hơn
Nhấp chuột vào đây để mở rộng...
Ý bạn là chỉ cần so sánh dữ liệu hiện tại với ô I9 trong sheet 1 đúng không?
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2)= Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                .Range("A7").End(xlDown).Offset(1) = .Range("A7").End(xlDown) + 1
                .Range("B7").End(xlDown).Offset(1) = Sheet1.Range("I9")
                .Range("C7").End(xlDown).Offset(1) = Sheet1.Range("I10")
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
 
Upvote 0
Ý mình là giả sử như sheet 2 và 3 là bảng trắng như file mình gửi kèm ấy, không có dữ liệu về các đơn vị, mình muốn là code có thể thêm mới mã đơn vị và tên đơn vị bắt đầu từ dòng thứ 7 trở đi và vẫn với yêu cầu là:
Tại ô I9, nhập mã đơn vị thì I10 sẽ ra tên đơn vị, nếu không có thì báo lỗi #N/A# ở I10. Khi báo lỗi như thế nghĩa là mã và tên đơn vị chưa có trong bảng tính, thì mình tự nhập tay tên đơn vị vào I10
+ Dữ liệu tại ô I9 và I10 sẽ được cập nhật sang 2 sheet CHUYEN KHOAN và TIEN MAT với điều kiện như sau:
- Nếu ô I8 là CHUYEN KHOAN thì dữ liệu I9 và I10 được thêm sang sheet CHUYEN KHOAN, nếu là TIEN MAT thì thêm sang sheet TIEN MAT
- Tại mỗi sheet dữ liệu là CHUYEN KHOAN hoặc TIEN MAT, sẽ kiểm tra theo mã ĐVQHNS tại ô I9 với các dữ liệu hiện có tại cột B của sheet (bắt đầu từ B7 trở đi), nếu đã có mã đó, thông báo lỗi "Mã ĐVQHNS" đã tồn tại, nếu chưa có thêm dữ liệu vào dòng cuối cùng chưa có dữ liệu trong 2 cột B và C trong đó: I9 là cột B, I10 là cột C.
Thật ra code bạn viết cho mình rất okie nếu như cơ sở dữ liệu của mỗi sheet mình gửi lên ban đầu không thay đổi, tuy nhiên nếu đầu năm mình thay đổi số đơn vị, mình phải xóa các tên đơn vị cũ đi và thêm mới thì dùng code nó sẽ báo lỗi.
Bạn rất nhiệt tình với mình, thật sự cảm ơn bạn rất nhiều. Giúp mình nhé, cảm ơn bạn
 

File đính kèm

  • Theo doi bien dong luong - Copy.xls
    83.5 KB · Đọc: 6
Upvote 0
acmen87 đã viết:
@vanthinh3101 anh ơi có sửa đc k ạ
Nhấp chuột vào đây để mở rộng...
Code của bạn đây
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String, lR As Long
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Code của bạn đây
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String, lR As Long
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhé
 
Upvote 0
vanthinh3101 đã viết:
Code của bạn đây
Mã: 
Sub AddNew()
    Dim sArr(), tArr(), I As Long, Tem As String, lR As Long
    sArr = Sheet2.Range("A7", Sheet2.Range("A7").End(xlDown)).Resize(, 16).Value
    tArr = Sheet3.Range("A7", Sheet3.Range("A7").End(xlDown)).Resize(, 15).Value
    With Sheet1
        Tem = .Range("I9") & " - " & .Range("I10")
        If .Range("I8") = "TIEN MAT" Then
            For I = 1 To UBound(tArr, 1)
                If tArr(I, 2) & " - " & tArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet3
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
           .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        Else
            For I = 1 To UBound(sArr, 1)
                If sArr(I, 2) & " - " & sArr(I, 3) = Tem Then
                    MsgBox "Ma DVQHNS da ton tai", vbCritical, "GPE"
                    .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
                    Exit Sub
                End If
            Next I
            With Sheet2
                lR = .Range("A" & Rows.Count).End(xlUp).Row + 2
                If lR = 7 Then
                    .Range("A7") = 1: .Range("B7") = Sheet1.Range("I9"): .Range("C7") = Sheet1.Range("I10")
                Else
                    .Range("A5").End(xlDown).Offset(1) = .Range("A5").End(xlDown) + 1
                    .Range("A5").End(xlDown).Offset(1, 1) = Sheet1.Range("I9")
                    .Range("A5").End(xlDown).Offset(1, 2) = Sheet1.Range("I10")
                End If
                MsgBox "Da them ma DVQHNS", vbInformation, "GPE"
            End With
            .Range("I10").Formula = "=IF(I8=""CHUYEN KHOAN"",VLOOKUP(I9,OFFSET('CHUYEN KHOAN'!B7,,,COUNTA('CHUYEN KHOAN'!C7:'CHUYEN KHOAN'!C7:C10000),2),2,0),VLOOKUP('CHENH LECH'!I9,OFFSET('TIEN MAT'!B7,,,COUNTA('TIEN MAT'!C7:'TIEN MAT'!C7:C10000),2),2,0))"
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Mình cảm ơn bạn đã giúp nhé, nhưng hiện tại code thêm mã đơn vị này đang lỗi bạn ạ. Mình chỉ thêm mới được 2 đơn vị vào mỗi sheet, sang đơn vị thứ 3 nó cứ ghi đè lên đơn vị số 2 mà mình đã thêm bạn ạ. Bạn xem giúp mình nhé. Cảm ơn bạn nhiều
 
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

ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
2
Đọc
8K
maikhoamt
maikhoamt
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
9
Đọc
216
Phan Thế Hiệp
Phan Thế Hiệp
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
16
Đọc
213
ptm0412
ptm0412
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
5
Đọc
110
VetMini
V
L
Các lấy công thức
Trả lời
5
Đọc
80
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom