Chuyên mục xử lý, gỡ rối code VBA

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

giaiphap · 4/6/18

mtuan đã viết:
Dạ Kính chào Anh
Nhờ Anh sửa lại code giúp em để các dòng tô màu đỏ tại File đính kèm khi nhấn nút " NHAP PHIEU THU" sẽ tự động lưu vào sheet DATA NHAP. Cứ mội lần nhập khoảng 12 ngày mua chung 1 phiếu thanh toán như trên a.
Rất mong nhận được sự giúp đở của A.
Kính chào Anh

Bạn sử dụng thử đoạn code này xem sao.

Mã:

rivate Sub NHAP_Click()
Dim n As Integer
n = Application.WorksheetFunction.CountA(Sheet3.Range("B12:B18"))
With Sheet9.Range("A65000").End(xlUp)
    .Offset(1).Resize(n) = Sheet3.[B3]
    .Offset(1, 1).Resize(n) = Sheet3.[D3]
    .Offset(1, 3).Resize(n) = Sheet3.[D5]
    .Offset(1, 7).Resize(n, 3).Value = Sheet3.Range("B12").Resize(n, 3).Value
End With
End Sub

mtuan · 5/6/18

giaiphap đã viết:

Bạn sử dụng thử đoạn code này xem sao.

Mã:

rivate Sub NHAP_Click()
Dim n As Integer
n = Application.WorksheetFunction.CountA(Sheet3.Range("B12:B18"))
With Sheet9.Range("A65000").End(xlUp)
    .Offset(1).Resize(n) = Sheet3.[B3]
    .Offset(1, 1).Resize(n) = Sheet3.[D3]
    .Offset(1, 3).Resize(n) = Sheet3.[D5]
    .Offset(1, 7).Resize(n, 3).Value = Sheet3.Range("B12").Resize(n, 3).Value
End With
End Sub

Cảm ơn Bạn Giaiphap rất nhiều. code quá tuyệt mình vận dụng được rồi. Đa tạ

mtuan · 5/6/18

mtuan đã viết:
Cảm ơn Bạn Giaiphap rất nhiều. code quá tuyệt mình vận dụng được rồi. Đa tạ

Em xin nhờ bạn giaiphap có thể viết giúp em đoạn code lọc số liệu từ sheet DATA NHAP sang sheet BANGKE với yêu cầu khi e gõ ngày thanh toán vào 1 ô cho sẳn ở sheet BANGKE thì excel tự lọc và điền vào các cột tương ứng và tách theo từng loại trợ giá trong sheet DATA NHAP. Anh có thể viết code và điền vài dữ liệu vào các cột trong sheet BANGKE cũng được em tự nghiên cứu và phát triển cho các cột kế tiếp. vì e muố phải đọc và hiểu code do e mới tập tành. mong A giúp đỡ. Chân thành cảm ơn A
*** và em cũng xin được Anh cũng như ae trong DD giúp! cảm ơn mọi người

giaiphap · 5/6/18

mtuan đã viết:
Em xin nhờ bạn giaiphap có thể viết giúp em đoạn code lọc số liệu từ sheet DATA NHAP sang sheet BANGKE với yêu cầu khi e gõ ngày thanh toán vào 1 ô cho sẳn ở sheet BANGKE thì excel tự lọc và điền vào các cột tương ứng và tách theo từng loại trợ giá trong sheet DATA NHAP. Anh có thể viết code và điền vài dữ liệu vào các cột trong sheet BANGKE cũng được em tự nghiên cứu và phát triển cho các cột kế tiếp. vì e muố phải đọc và hiểu code do e mới tập tành. mong A giúp đỡ. Chân thành cảm ơn A
*** và em cũng xin được Anh cũng như ae trong DD giúp! cảm ơn mọi người

Bạn phải mô tả chi tiết hơn, tôi nhìn vào không biết lấy dữ liệu cột nào để điền vào cột trọng lượng, cột tổng giá thanh toán tính bằng cách nào, cột M để trống là sao? Còn điều kiện lọc là lọc ngày thanh toán hay ngày mua...

mtuan · 6/6/18

giaiphap đã viết:
Bạn phải mô tả chi tiết hơn, tôi nhìn vào không biết lấy dữ liệu cột nào để điền vào cột trọng lượng, cột tổng giá thanh toán tính bằng cách nào, cột M để trống là sao? Còn điều kiện lọc là lọc ngày thanh toán hay ngày mua...

Chào bạn giaiphap
Bạn điền ngày mua, tên khách, địa chỉ vào cột tương ứng trong bảng kê có gì mình nghiên cứu code của bạn mình thay đổi dữ liệu tại các cột khác. cột trọng lượng là điền cột trọng lượng bên sheet DATA NHAP. Còn cột M là ghi chú ko có cũng dc. còn cột tổng giá sẽ làm bằng công thức à dc bạn à.
Mình đã điền mẫu vào sheet BANGKE bạn xem thử nha.
mỗi ngày có thể thanh toán nhiều phiếu đã mua trước đó. nên khi nhập ngày thanh toán thì ngày này sẽ lọc ra đã thanh toán cho các ngày nò và thanh toán tại nhà máy nào và tác ra từng loại trợ giá.
Cảm ơn bạn nhiều vì đã giúp đỡ.

giaiphap · 6/6/18

mtuan đã viết:
Chào bạn giaiphap
Bạn điền ngày mua, tên khách, địa chỉ vào cột tương ứng trong bảng kê có gì mình nghiên cứu code của bạn mình thay đổi dữ liệu tại các cột khác. cột trọng lượng là điền cột trọng lượng bên sheet DATA NHAP. Còn cột M là ghi chú ko có cũng dc. còn cột tổng giá sẽ làm bằng công thức à dc bạn à.
Mình đã điền mẫu vào sheet BANGKE bạn xem thử nha.
mỗi ngày có thể thanh toán nhiều phiếu đã mua trước đó. nên khi nhập ngày thanh toán thì ngày này sẽ lọc ra đã thanh toán cho các ngày nò và thanh toán tại nhà máy nào và tác ra từng loại trợ giá.
Cảm ơn bạn nhiều vì đã giúp đỡ.

Bạn xem file đúng yêu cầu của mình chưa nhé! Sau đó phát triển thêm.

mtuan · 6/6/18

giaiphap đã viết:
Bạn xem file đúng yêu cầu của mình chưa nhé! Sau đó phát triển thêm.

Chào bạn
Trước tiên xin chân thành cảm ơn bạn đã giúp đỡ.
Dạ gần đúng với ý em còn 1 tí nữa là ok.
Hiện tại kiến thức và kinh nghiệm về VB của mình chưa dịch và chưa hiểu hết đoạn code của bạn. nhưng nhờ bạn thêm một vấn đề như thế này theo ý 1
1. Trong sheet BANGKE sẽ nhập Ngày thanh toán tại ô A3 và nhập tên kho tại ô C7 thì sẽ lọc ra hết các ngày được mua trước đó. Vì yêu cầu phải lọc ra ngày thanh toán và của kho nào.
vd: ngày 05/04/2018 thanh toán cho các ngày 02/04; 03/04; 04/04; 05/04 kho phú bình thì lọc ra được các ngày 2;3;4;5/04 tại kho phú bình, chứ không chỉ lọc ngày 05/04 không thôi và ngày mua sẽ ko lớn hơn ngày thanh toán.
ý 2 và ý 3 ok rồi A. nhưng có thể phần text bên dưới không cần phải dùng code dc không anh. và sao mình không gõ thẳng một đoạn "Giám đốc doanh nghiệp" mà phải + &. Anh có thể giải thích dùm e luôn nha. em cảm ơn nhiều

giaiphap · 6/6/18

mtuan đã viết:
Chào bạn
Trước tiên xin chân thành cảm ơn bạn đã giúp đỡ.
Dạ gần đúng với ý em còn 1 tí nữa là ok.
Hiện tại kiến thức và kinh nghiệm về VB của mình chưa dịch và chưa hiểu hết đoạn code của bạn. nhưng nhờ bạn thêm một vấn đề như thế này
1. Trong sheet BANGKE sẽ nhập Ngày thanh toán tại ô A3 và nơi mua (KHO) tại ô C7 thì sẽ lọc ra hết các ngày được mua trước đó. Vì yêu cầu phải lọc ra ngày thanh toán và ngồi thanh toán tại nhà máy đó. nói rõ là có khi mua tại nơi này tính tiền tại chổ có khi KH họ đem qua chổ khác hoặc đến CTy thanh toán luôn. nên bên sheet DATA NHAP em co nơi mua và nơi TT. vì cuối ngày về e phải lọc ra ngày nay chi bao nhiêu tiền và chi chổ nào cònviệc chi cho ai chi mua nhà máy nào họ ko quan tâm.
vd: ngày 05/04/2018 thanh toán cho các ngày 02/04; 03/04; 04/04; 05/04 chứ không chỉ lọc ngày 05/04 không thôi và ngày mua sẽ ko lớn hơn ngày thanh toán.
2. Bang Kê chỉnh dùm cái hàng "Tổng hộ bán thýờng xuyên ðýợc trợ giá (+.... ðồng/TSC) lên trên và các số liệu sẽ xuất hiện bên dưới thay vì đang là cột tổng nằm dưới vì mình phải sử dụng mẫu của BTC.
3. cột ngày mua định dạng ngày bị chuyển sang số nữa bạn ơi.
em có gửi lại file mẫu nha A bên sheet DATA NHAP có các tiêu đề tô đỏ

Tôi sửa code để thục hiện ý 2 và 3 của bạn, còn ý 1 thì đọc hoài vẫn chưa hiểu ô C7 nhập vào để làm việc gì trong điều kiện lọc của bạn, vã lại nơi TT là cột nào sao tôi tìm không thấy.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, ary
If Target.Address = "$A$3" Then
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value
    iCol = Array(9, 4, 5, 6, 7, 1, 12, 1, 1, 11, 13, 1, 14)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If Ngay >= Arr(i, 2) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("A" & i).Value = "T" & ChrW(7893) & "ng h" & ChrW(7897) & " bán thý" & ChrW(7901) & "ng xuyên ðý" & ChrW(7907) & _
                    "c tr" & ChrW(7907) & " giá (+" & .Range("M" & (i + 1)).Value & " ð" & ChrW(7891) & "ng/TSC)"
                    .Range("A" & i).Font.Bold = True
                End If
            Next i
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "B" & ChrW(7857) & "ng ch" & ChrW(7919) & ":"
                .Offset(2, 1).Value = "Ngý" & ChrW(7901) & "i l" & ChrW(7863) & "p b" & ChrW(7843) & "ng kê"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngày ... tháng .... nãm ....."
                .Offset(2, 11).Value = "Giám ð" & ChrW(7889) & "c doanh nghi" & ChrW(7879) & "p"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(K" & ChrW(253) & ", ghi r" & ChrW(245) & " h" & ChrW(7885) & " tên)"
                .Offset(3, 11).Value = "(K" & ChrW(253) & " tên, ðóng d" & ChrW(7845) & "u)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
            End With
        End With
   End If
End If
End Sub

mtuan · 6/6/18

giaiphap đã viết:

Tôi sửa code để thục hiện ý 2 và 3 của bạn, còn ý 1 thì đọc hoài vẫn chưa hiểu ô C7 nhập vào để làm việc gì trong điều kiện lọc của bạn, vã lại nơi TT là cột nào sao tôi tìm không thấy.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, ary
If Target.Address = "$A$3" Then
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value
    iCol = Array(9, 4, 5, 6, 7, 1, 12, 1, 1, 11, 13, 1, 14)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If Ngay >= Arr(i, 2) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("A" & i).Value = "T" & ChrW(7893) & "ng h" & ChrW(7897) & " bán thý" & ChrW(7901) & "ng xuyên ðý" & ChrW(7907) & _
                    "c tr" & ChrW(7907) & " giá (+" & .Range("M" & (i + 1)).Value & " ð" & ChrW(7891) & "ng/TSC)"
                    .Range("A" & i).Font.Bold = True
                End If
            Next i
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "B" & ChrW(7857) & "ng ch" & ChrW(7919) & ":"
                .Offset(2, 1).Value = "Ngý" & ChrW(7901) & "i l" & ChrW(7863) & "p b" & ChrW(7843) & "ng kê"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngày ... tháng .... nãm ....."
                .Offset(2, 11).Value = "Giám ð" & ChrW(7889) & "c doanh nghi" & ChrW(7879) & "p"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(K" & ChrW(253) & ", ghi r" & ChrW(245) & " h" & ChrW(7885) & " tên)"
                .Offset(3, 11).Value = "(K" & ChrW(253) & " tên, ðóng d" & ChrW(7845) & "u)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
            End With
        End With
   End If
End If
End Sub

Trước tiên xin chân thành cảm ơn bạn đã giúp đỡ.
Dạ gần đúng với ý em còn 1 tí nữa là ok.
Hiện tại kiến thức và kinh nghiệm về VB của mình chưa dịch và chưa hiểu hết đoạn code của bạn. nhưng nhờ bạn thêm một vấn đề như thế này theo ý 1
1. Trong sheet BANGKE sẽ nhập Ngày thanh toán tại ô A3 và nhập tên kho tại ô C7 thì sẽ lọc ra hết các ngày được mua trước đó. Vì yêu cầu phải lọc ra ngày thanh toán và của kho nào.
vd: ngày 05/04/2018 thanh toán cho các phiếu mua từ ngày 02/04; 03/04; 04/04; 05/04 kho phú bình thì lọc ra được các ngày 2;3;4;5/04 tại kho phú bình, chứ không chỉ lọc ngày 05/04 không thôi và khi nhập ngày TT thì chỉ lọc từ các ngày mua từ ngày TT đó trở về trước.
ý 2 và ý 3 ok rồi A. nhưng có thể phần text bên dưới không cần phải dùng code dc không anh. và sao mình không gõ thẳng một đoạn "Giám đốc doanh nghiệp" mà phải + &. Anh có thể giải thích dùm e luôn nha. em cảm ơn nhiều

giaiphap · 6/6/18

mtuan đã viết:
Trước tiên xin chân thành cảm ơn bạn đã giúp đỡ.
Dạ gần đúng với ý em còn 1 tí nữa là ok.
Hiện tại kiến thức và kinh nghiệm về VB của mình chưa dịch và chưa hiểu hết đoạn code của bạn. nhưng nhờ bạn thêm một vấn đề như thế này theo ý 1
1. Trong sheet BANGKE sẽ nhập Ngày thanh toán tại ô A3 và nhập tên kho tại ô C7 thì sẽ lọc ra hết các ngày được mua trước đó. Vì yêu cầu phải lọc ra ngày thanh toán và của kho nào.
vd: ngày 05/04/2018 thanh toán cho các phiếu mua từ ngày 02/04; 03/04; 04/04; 05/04 kho phú bình thì lọc ra được các ngày 2;3;4;5/04 tại kho phú bình, chứ không chỉ lọc ngày 05/04 không thôi và khi nhập ngày TT thì chỉ lọc từ các ngày mua từ ngày TT đó trở về trước.
ý 2 và ý 3 ok rồi A. nhưng có thể phần text bên dưới không cần phải dùng code dc không anh. và sao mình không gõ thẳng một đoạn "Giám đốc doanh nghiệp" mà phải + &. Anh có thể giải thích dùm e luôn nha. em cảm ơn nhiều

Ví dụ nhập vào C7 là Phú Bình thì chỉ lọc kho Phú Bình, còn kho Long Hòa không lọc đúng không? Thứ hai là bạn thử nhập "Giám đốc doanh nghiệp" được rồi hả tính tiếp nhé.

mtuan · 6/6/18

mtuan đã viết:
Cảm ơn Bạn Giaiphap rất nhiều. code quá tuyệt mình vận dụng được rồi. Đa tạ

Chào bạn
Bạn vui lòng giúp mình là khi nhấn nút nhập dữ liệu và nhấn 1 lần là nút nhập tự mờ sau đó mình nhấp tạo phiếu mới thì nút nhập hiện ra. vì nếu quen tay mà nhấn liên tục thì nhập trùng liên tục. và trong lúc nhập bị sai mình có thể tạo một nút button goi số phiếu đó lại để sửa sau đó lưu chồng lên đúng với số phiếu đó không Bạn.
Cảm ơn Bạn rất nhiều vì mấy ngày nay đã giúp đỡ mình.

mtuan · 6/6/18

giaiphap đã viết:
Ví dụ nhập vào C7 là Phú Bình thì chỉ lọc kho Phú Bình, còn kho Long Hòa không lọc đúng không? Thứ hai là bạn thử nhập "Giám đốc doanh nghiệp" được rồi hả tính tiếp nhé.

Dạ đúng! chỉ lọc kho nào dc nhập thôi ạ. à chổ Giám đốc mình chưa nhập nhưng do chưa hiểu nên hỏi để hiểu ý nghĩa thôi ạ. Thank Bạn

giaiphap · 6/6/18

mtuan đã viết:
Dạ đúng! chỉ lọc kho nào dc nhập thôi ạ. à chổ Giám đốc mình chưa nhập nhưng do chưa hiểu nên hỏi để hiểu ý nghĩa thôi ạ. Thank Bạn

Nếu vậy thì sửa code thế này nhé. Còn việc gõ trực tiếp tên tiếng việt theo bảng mã Unicode trong code là không thể, chính vì vậy những ký tự không dấu thì gõ trực tiếp được còn những ký tự chứa mã Unicode thì bắt buộc phải dùng hàm ChrW để chuyển.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, Kho As String
If Target.Address = "$A$3" Then
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: Kho = Sheet25.[C7]
    iCol = Array(9, 4, 5, 6, 7, 1, 12, 1, 1, 11, 13, 1, 14)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay >= Arr(i, 2)) And (Kho = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("A" & i).Value = "T" & ChrW(7893) & "ng h" & ChrW(7897) & " bán thý" & ChrW(7901) & "ng xuyên ðý" & ChrW(7907) & _
                    "c tr" & ChrW(7907) & " giá (+" & .Range("M" & (i + 1)).Value & " ð" & ChrW(7891) & "ng/TSC)"
                    .Range("A" & i).Font.Bold = True
                End If
            Next i
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "B" & ChrW(7857) & "ng ch" & ChrW(7919) & ":"
                .Offset(2, 1).Value = "Ngý" & ChrW(7901) & "i l" & ChrW(7863) & "p b" & ChrW(7843) & "ng kê"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngày ... tháng .... nãm ....."
                .Offset(2, 11).Value = "Giám ð" & ChrW(7889) & "c doanh nghi" & ChrW(7879) & "p"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(K" & ChrW(253) & ", ghi r" & ChrW(245) & " h" & ChrW(7885) & " tên)"
                .Offset(3, 11).Value = "(K" & ChrW(253) & " tên, ðóng d" & ChrW(7845) & "u)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
            End With
        End With
   End If
End If
End Sub

kimdong_vfu · 7/6/18

Cho mình hỏi chút các bác. Mình có form dữ liệu như file đính kèm.
Ví dụ mình muốn viết code để copy dữ liệu giữ các Sheet qua lại với nhau. Cụ thể ở đây là Sheet TMV.Map sang Sheet Vietmap
Copy A2:A9 từ TMV.Map sang A2:A9 Vietmap
Copy B2:B9 từ TMV.Map sang B2:B9 Vietmap
Copy E2:E9 từ TMV.Map sang G2:G9 Vietmap
và các cột khác có dữ liệu tương ứng nữa.
Mình có record sồi sửa nhưng tốc độ nó chậm và bị lỗi.
Xin các bác chỉ giáo cho em mấy dòng, còn các dòng sau em tự bổ sung
Thanks all!

phulien1902 · 7/6/18

kimdong_vfu đã viết:
Cho mình hỏi chút các bác. Mình có form dữ liệu như file đính kèm.
Ví dụ mình muốn viết code để copy dữ liệu giữ các Sheet qua lại với nhau. Cụ thể ở đây là Sheet TMV.Map sang Sheet Vietmap
Copy A2:A9 từ TMV.Map sang A2:A9 Vietmap
Copy B2:B9 từ TMV.Map sang B2:B9 Vietmap
Copy E2:E9 từ TMV.Map sang G2:G9 Vietmap
và các cột khác có dữ liệu tương ứng nữa.
Mình có record sồi sửa nhưng tốc độ nó chậm và bị lỗi.
Xin các bác chỉ giáo cho em mấy dòng, còn các dòng sau em tự bổ sung
Cảm ơn all!

Bạn thử:

PHP:

Sub abc()
    With Sheets("TMV.Map")
        .Range("A2:B9").Copy Sheets("Vietmap").Range("A2")
        .Range("E2:E9").Copy Sheets("Vietmap").Range("G2")
    End With
End Sub

Ba Tê · 7/6/18

kimdong_vfu đã viết:
Copy A2:A9 từ TMV.Map sang A2:A9 Vietmap
Copy B2:B9 từ TMV.Map sang B2:B9 Vietmap
Copy E2:E9 từ TMV.Map sang G2:G9 Vietmap

PHP:

Public Sub GPE()
With Sheets("Vietmap")
    .Range("A2:B9").Value = Sheets("TMV.Map").Range("A2:B9").Value
    .Range("E2:E9").Value = Sheets("TMV.Map").Range("G2:G9").Value
End With
End Sub

kimdong_vfu · 7/6/18

phulien1902 đã viết:
Bạn thử:

PHP:

Sub abc() With Sheets("TMV.Map") .Range("A2:B9").Copy Sheets("Vietmap").Range("A2") .Range("E2:E9").Copy Sheets("Vietmap").Range("G2") End With End Sub

thanks Bác nhé!

Bài đã được tự động gộp: 7/6/18

Ba Tê đã viết:

PHP:

Public Sub GPE()
With Sheets("Vietmap")
    .Range("A2:B9").Value = Sheets("TMV.Map").Range("A2:B9").Value
    .Range("E2:E9").Value = Sheets("TMV.Map").Range("G2:G9").Value
End With
End Sub

Cảm ơn Bác!

mtuan · 8/6/18

giaiphap đã viết:

Nếu vậy thì sửa code thế này nhé. Còn việc gõ trực tiếp tên tiếng việt theo bảng mã Unicode trong code là không thể, chính vì vậy những ký tự không dấu thì gõ trực tiếp được còn những ký tự chứa mã Unicode thì bắt buộc phải dùng hàm ChrW để chuyển.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, Kho As String
If Target.Address = "$A$3" Then
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: Kho = Sheet25.[C7]
    iCol = Array(9, 4, 5, 6, 7, 1, 12, 1, 1, 11, 13, 1, 14)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay >= Arr(i, 2)) And (Kho = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("A" & i).Value = "T" & ChrW(7893) & "ng h" & ChrW(7897) & " bán thý" & ChrW(7901) & "ng xuyên ðý" & ChrW(7907) & _
                    "c tr" & ChrW(7907) & " giá (+" & .Range("M" & (i + 1)).Value & " ð" & ChrW(7891) & "ng/TSC)"
                    .Range("A" & i).Font.Bold = True
                End If
            Next i
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "B" & ChrW(7857) & "ng ch" & ChrW(7919) & ":"
                .Offset(2, 1).Value = "Ngý" & ChrW(7901) & "i l" & ChrW(7863) & "p b" & ChrW(7843) & "ng kê"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngày ... tháng .... nãm ....."
                .Offset(2, 11).Value = "Giám ð" & ChrW(7889) & "c doanh nghi" & ChrW(7879) & "p"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(K" & ChrW(253) & ", ghi r" & ChrW(245) & " h" & ChrW(7885) & " tên)"
                .Offset(3, 11).Value = "(K" & ChrW(253) & " tên, ðóng d" & ChrW(7845) & "u)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
            End With
        End With
   End If
End If
End Sub

Dạ e hiểu rồi Để em nhập xong xem thế nào.à mà cái button nhập khi nhấn 1 lần tự mờ a xem giúp code dùm e với nha. Cảm ơn A nhiều

kimdong_vfu · 8/6/18

phulien1902 đã viết:
Bạn thử:

PHP:

Sub abc() With Sheets("TMV.Map") .Range("A2:B9").Copy Sheets("Vietmap").Range("A2") .Range("E2:E9").Copy Sheets("Vietmap").Range("G2") End With End Sub

Cho mình hỏi vấn đề này nữa ạ
Mình có 2 sheet như sau:
1. Sheet "CSDL" tức là sheet cần phải cập nhật thông tin
2. Sheet "Thongtin" tức là sheet thông tin để cập nhập vào sheet "CSDL"
2 sheet CSDL và Thongtin có các cột tương ứng như nhau.
Giờ mình muốn thế này. Nếu thông tin ở Cột A và Cột B của Sheet "CSDL" và sheet "Thongtin" giống nhau thì các thông tin từ cột M đến cột AF
của sheet "Thongtin" nó sẽ copy nhặt sang sheet "CSDL"
thanks các bác.

hieungxngoc · 8/6/18

kimdong_vfu đã viết:
Cho mình hỏi vấn đề này nữa ạ
Mình có 2 sheet như sau:
1. Sheet "CSDL" tức là sheet cần phải cập nhật thông tin
2. Sheet "Thongtin" tức là sheet thông tin để cập nhập vào sheet "CSDL"
2 sheet CSDL và Thongtin có các cột tương ứng như nhau.
Giờ mình muốn thế này. Nếu thông tin ở Cột A và Cột B của Sheet "CSDL" và sheet "Thongtin" giống nhau thì các thông tin từ cột M đến cột AF
của sheet "Thongtin" nó sẽ copy nhặt sang sheet "CSDL"
Cảm ơn các bác.

Sub test()

Dim i, lr As Integer

lr = Sheets("Thongtin").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lr

If Sheets("Thongtin").Range("A" & i) = Sheets("CSDL").Range("A" & i) And _

Sheets("Thongtin").Range("B" & i) = Sheets("CSDL").Range("B" & i) Then

Sheets("CSDL").Range("M" & i & ":AF" & i).Value = Sheets("Thongtin").Range("M" & i & ":AF" & i).Value

End If

Next

End Sub

Bạn thử xem

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại GPE

==(^o^)==

Thành viên mới

Thành viên mới

File đính kèm

==(^o^)==

Thành viên mới

File đính kèm

==(^o^)==

File đính kèm

Thành viên mới

File đính kèm

==(^o^)==

Thành viên mới

==(^o^)==

Thành viên mới

Thành viên mới

==(^o^)==

Thành viên mới

File đính kèm

GPE - My love

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

Facebook

Group