Chuyên mục xử lý, gỡ rối code VBA (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)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
huongmuine đã viết:
Cảm ơn Thầy đã giúp đỡ.
NHờ Thầy giúp cho tí nữa ạ:
- Khi nhập 1 ở ô K1 sẽ lọc ra 10 dòng dữ liệu ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB như hiện tại
- Khi nhập 2 ở ô K1 sẽ lọc ra 10 dòng dữ liệu tiếp theo ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB và cột STT sẽ tính bắt đầu từ 11 đến 20
( trong file khi sửa dữ liệu cột lớp sheet Data thì sheet AB lọc không đủ 10 dòng dữ liệu )
Nhấp chuột vào đây để mở rộng...
Bạn xem lại file này, dữ liệu mẫu cũng phải tương đối có đủ dữ liệu, đưa dữ liệu chỉ có 1 lớp sao kiểm tra được?
 

File đính kèm

Upvote 0
Có cách nào chỉ nhập dữ liệu không trùng mà không nhập dữ liệu trùng không mọi người, ko dùng xóa dữ liệu trùng?
 
Upvote 0
Ba Tê đã viết:
Thử xem file này coi có đúng ý bạn không.
Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?
Nhờ Bác #Ba Tê xem giúp em!
 

File đính kèm

Upvote 0
tiendungnst đã viết:
Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?
Nhờ Bác #Ba Tê xem giúp em!
Nhấp chuột vào đây để mở rộng...
Chuyển từ một ô sang một vùng?
Chèn dòng là chuyện của bạn, tôi không biết à nghe!
 

File đính kèm

Upvote 0
Nhờ các anh chị chỉnh sửa giúp code.

1. Nhờ anh chị chỉnh code khi "phân tích vật tư" thì tại ô G9 khi click sẽ là =1.03*200 chứ không phải là 206. giống như cột D13 tại sheet CSDL DM

2. Nhờ a thêm code thêm đơn vị vật liệu tại cột E, Hiện tại cột E chỉ hiện đơn vị cho hàng đầu thôi.
 

File đính kèm

Upvote 0
Mọi người xem giúp em code trong Module Tong_hop_cong này sai ở đâu mà không chạy

PHP: 
Option Explicit
Private Sub Tong_cong()
Dim Dic As Object, Col As Object, ws As Worksheet, Tem As String, Rws As Long
Dim R As Long, I As Long, J As Long, K As Long, C As Long
Dim sArr As Variant, dArr(1 To 10000, 1 To 40)
Set Dic = CreateObject("Scripting.Dictionary")

Set Col = CreateObject("Scripting.Dictionary")
With Application
    .CalculateBeforeSave = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .EnableCancelKey = xlErrorHandler
End With

With Sheets("Tong hop cong")
    If CStr(.Range("C7")) <> "" Then
        .Range("C8:BP7000").ClearContents
    End If
    sArr = .Range("B6").Resize(, 34).Value
    For J = 4 To 34
        If sArr(1, J) <> Empty Then
            If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
        End If
    Next J
    For I = 2 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then
            Dic.Item(sArr(I, 1)) = I
        End If
    Next I
End With
For Each ws In Worksheets
    If IsNumeric(ws.Name) Then
        C = Col.Item(Val(ws.Name))
        sArr = ws.Range("B2", ws.Range("B65000").End(xlUp)).Resize(, 17).Value
        For I = 1 To UBound(sArr, 1)
             Tem=sarr(I,1)
            If Len(sArr(I, 1)) = 5 And Left(sArr(I, 1), 1) < 3 And sArr(I, 17) > 0 Then
                If Dic.exists(Tem) Then
                    K = K + 1
                    dArr(K, 1) = 1
                    dArr(K, 2) = sArr(I, 1)
                    dArr(K, 3) = sArr(I, 2)
                End If
                Rws = Dic.Item(Tem)
                dArr(Rws, C) = sArr(I, 17)
            End If
        Next I
    End If
Next ws
Sheets("Tong hop cong").Range("B8").Resize(K, 34) = dArr
Set Dic = Nothing
Set Col = Nothing
With Application
    .CalculateBeforeSave = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .CalculateBeforeSave = True
    .EnableCancelKey = xlInterrupt
End With
End Sub

Nguyên tắc là từ list ID cột B trong sheet Tong hop cong, tổng hợp toàn bộ công của các ngày sheet và add vào ngày tương ứng. Ví dụ em có ID 11111, em rà soát các ngày công 26 27 và 28, tại cột R của các sheet này nếu lớn hơn không thì add vào cột ngày tương ứng của sheet Tong hop cong. Từ bài lần trước của bạn hkphuong giúp đỡ cứ tưởng là đã hiểu sơ sơ về Dic rồi vậy mà không hiểu sao lại sai :(
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
tueyennhi đã viết:
Mọi người xem giúp em code trong Module Tong_hop_cong này sai ở đâu mà không chạy

PHP: 
Option Explicit
Private Sub Tong_cong()
Dim Dic As Object, Col As Object, ws As Worksheet, Tem As String, Rws As Long
Dim R As Long, I As Long, J As Long, K As Long, C As Long
Dim sArr As Variant, dArr(1 To 10000, 1 To 40)
Set Dic = CreateObject("Scripting.Dictionary")

Set Col = CreateObject("Scripting.Dictionary")
With Application
    .CalculateBeforeSave = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .EnableCancelKey = xlErrorHandler
End With

With Sheets("Tong hop cong")
    If CStr(.Range("C7")) <> "" Then
        .Range("C8:BP7000").ClearContents
    End If
    sArr = .Range("B6").Resize(, 34).Value
    For J = 4 To 34
        If sArr(1, J) <> Empty Then
            If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
        End If
    Next J
    For I = 2 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then
            Dic.Item(sArr(I, 1)) = I
        End If
    Next I
End With
For Each ws In Worksheets
    If IsNumeric(ws.Name) Then
        C = Col.Item(Val(ws.Name))
        sArr = ws.Range("B2", ws.Range("B65000").End(xlUp)).Resize(, 17).Value
        For I = 1 To UBound(sArr, 1)
            If Len(sArr(I, 1)) = 5 And Left(sArr(I, 1), 1) < 3 And sArr(I, 17) > 0 Then
                If Dic.exists(sArr(I, 1)) Then
                    K = K + 1
                    dArr(K, 1) = 1
                    dArr(K, 2) = sArr(I, 1)
                    dArr(K, 3) = sArr(I, 2)
                End If
                Rws = Dic.Item(Tem)
                dArr(Rws, C) = sArr(I, 17)
            End If
        Next I
    End If
Next ws
Sheets("Tong hop cong").Range("B8").Resize(K, 34) = dArr
Set Dic = Nothing
Set Col = Nothing
With Application
    .CalculateBeforeSave = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .CalculateBeforeSave = True
    .EnableCancelKey = xlInterrupt
End With
End Sub

Nguyên tắc là từ list ID cột B trong sheet Tong hop cong, tổng hợp toàn bộ công của các ngày sheet và add vào ngày tương ứng. Ví dụ em có ID 11111, em rà soát các ngày công 26 27 và 28, tại cột R của các sheet này nếu lớn hơn không thì add vào cột ngày tương ứng của sheet Tong hop cong. Từ bài lần trước của bạn hkphuong giúp đỡ cứ tưởng là đã hiểu sơ sơ về Dic rồi vậy mà không hiểu sao lại sai :(
Nhấp chuột vào đây để mở rộng...
Code của bạn có đoạn: Rws = Dic.Item(Tem)
Biến Tem tính toán từ đâu ra vậy?
 
Upvote 0
ndu96081631 đã viết:
Code của bạn có đoạn: Rws = Dic.Item(Tem)
Biến Tem tính toán từ đâu ra vậy?
Nhấp chuột vào đây để mở rộng...
Từ đoạn này
For I = 1 To UBound(sArr, 1)
If Len(sArr(I, 1)) = 5 And Left(sArr(I, 1), 1) < 3 And sArr(I, 17) > 0 Then

Em đặt Tem như vậy thầy ạ.
Tem = sarr(i,1)
For I = 1 To UBound(sArr, 1)

Cả đoạn sẽ là như sau
PHP: 
Option Explicit
Private Sub Tong_cong()
Dim Dic As Object, Col As Object, ws As Worksheet, Tem As String, Rws As Long
Dim R As Long, I As Long, J As Long, K As Long, C As Long
Dim sArr As Variant, dArr(1 To 10000, 1 To 40)
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Application
    .CalculateBeforeSave = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .EnableCancelKey = xlErrorHandler
End With
With Sheets("Tong hop cong")
    sArr = .Range("B6").Resize(100, 34).Value
    For J = 4 To 34
        If sArr(1, J) <> Empty Then
            If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
        End If
    Next J
    Set Dic = CreateObject("Scripting.Dictionary")
    For I = 2 To UBound(sArr, 1)
        Dic.Item(sArr(I, 1)) = I
    Next
End With
For Each ws In Worksheets
    If IsNumeric(ws.Name) Then
        C = Col.Item(Val(ws.Name))
        sArr = ws.Range("B2", ws.Range("B65000").End(xlUp)).Resize(, 17).Value
        For I = 1 To UBound(sArr, 1)
            Tem = sArr(I, 1)
            If Len(sArr(I, 1)) = 5 And Left(sArr(I, 1), 1) < 3 And sArr(I, 17) > 0 Then
                If Dic.exists(Tem) Then
                    K = K + 1
                    dArr(K, 1) = sArr(I, 1)
                    dArr(K, 2) = sArr(I, 2)
                    dArr(K, 3) = sArr(I, 3)
                End If
                Rws = Dic.Item(Tem)
                dArr(Rws, C) = sArr(I, 17)
            End If
        Next I
    End If
Next ws
Sheets("Tong hop cong").Range("B7").Resize(K, 34) = dArr
Set Dic = Nothing
Set Col = Nothing
sArr = Range("A6").CurrentRegion
R = UBound(sArr, 1)
C = UBound(sArr, 2)
ReDim tArr(2 To R, 1 To 5)
For I = 2 To R
    For J = 5 To C
        If sArr(1, J) <= sArr(I, 1) Then
            If IsNumeric(sArr(I, J)) Then
                tArr(I, 1) = tArr(I, 1) + sArr(I, J)
            ElseIf sArr(I, J) Like "1D" Then
                tArr(I, 2) = Application.WorksheetFunction.Sum(tArr(I, 2) + Left(sArr(I, J), InStr(1, sArr(I, J), "D") - 1))
            End If
        ElseIf sArr(1, J) > sArr(I, 1) Then
            If IsNumeric(sArr(I, J)) Then
                tArr(I, 3) = tArr(I, 3) + sArr(I, J)
            ElseIf sArr(I, J) Like "1D" Then
                tArr(I, 4) = Application.WorksheetFunction.Sum(tArr(I, 4) + Left(sArr(I, J), InStr(1, sArr(I, J), "D") - 1))
            End If
        End If
    Next J
    tArr(I, 5) = tArr(I, 1) + tArr(I, 2) + tArr(I, 3) + tArr(I, 4)
Next I
Sheets("Tong hop cong").Range("AK7").Resize(I - 2, 5) = tArr
Sheets("Tong hop cong").Range("A6").CurrentRegion.Borders.LineStyle = xlContinuous
With Application
    .CalculateBeforeSave = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .CalculateBeforeSave = True
    .EnableCancelKey = xlInterrupt
End With
End Sub

Em bị báo lỗi dòng
dArr(Rws, C) = sArr(I, 17)
 
Lần chỉnh sửa cuối:
Upvote 0
tueyennhi đã viết:
Mọi người xem giúp em code trong Module Tong_hop_cong này sai ở đâu mà không chạy

PHP: 
Option Explicit
Private Sub Tong_cong()
Dim Dic As Object, Col As Object, ws As Worksheet, Tem As String, Rws As Long
Dim R As Long, I As Long, J As Long, K As Long, C As Long
Dim sArr As Variant, dArr(1 To 10000, 1 To 40)
Set Dic = CreateObject("Scripting.Dictionary")

Set Col = CreateObject("Scripting.Dictionary")
With Application
    .CalculateBeforeSave = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .EnableCancelKey = xlErrorHandler
End With

With Sheets("Tong hop cong")
    If CStr(.Range("C7")) <> "" Then
        .Range("C8:BP7000").ClearContents
    End If
    sArr = .Range("B6").Resize(, 34).Value
    For J = 4 To 34
        If sArr(1, J) <> Empty Then
            If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
        End If
    Next J
    For I = 2 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then
            Dic.Item(sArr(I, 1)) = I
        End If
    Next I
End With
For Each ws In Worksheets
    If IsNumeric(ws.Name) Then
        C = Col.Item(Val(ws.Name))
        sArr = ws.Range("B2", ws.Range("B65000").End(xlUp)).Resize(, 17).Value
        For I = 1 To UBound(sArr, 1)
             Tem=sarr(I,1)
            If Len(sArr(I, 1)) = 5 And Left(sArr(I, 1), 1) < 3 And sArr(I, 17) > 0 Then
                If Dic.exists(Tem) Then
                    K = K + 1
                    dArr(K, 1) = 1
                    dArr(K, 2) = sArr(I, 1)
                    dArr(K, 3) = sArr(I, 2)
                End If
                Rws = Dic.Item(Tem)
                dArr(Rws, C) = sArr(I, 17)
            End If
        Next I
    End If
Next ws
Sheets("Tong hop cong").Range("B8").Resize(K, 34) = dArr
Set Dic = Nothing
Set Col = Nothing
With Application
    .CalculateBeforeSave = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .CalculateBeforeSave = True
    .EnableCancelKey = xlInterrupt
End With
End Sub

Nguyên tắc là từ list ID cột B trong sheet Tong hop cong, tổng hợp toàn bộ công của các ngày sheet và add vào ngày tương ứng. Ví dụ em có ID 11111, em rà soát các ngày công 26 27 và 28, tại cột R của các sheet này nếu lớn hơn không thì add vào cột ngày tương ứng của sheet Tong hop cong. Từ bài lần trước của bạn hkphuong giúp đỡ cứ tưởng là đã hiểu sơ sơ về Dic rồi vậy mà không hiểu sao lại sai :(
Nhấp chuột vào đây để mở rộng...

sArr = .Range("B6").Resize(, 34).Value chỉ có 1 dòng thôi
 
Upvote 0
Sub Button16_click()
Dim printFrom As Integer, printTo As Integer, I As Integer
Dim Ra As Range
'================================

printFrom = Sheets("PYC").Range("AG3").Value 'STT bat dau
printTo = Sheets("PYC").Range("AG4").Value 'STT ket thuc

'================================

For I = printFrom To printTo
Sheets("PYC").Range("AG1").Value = I
Sheets("PYC").PrintOut preview:=False
Next I
End Sub

Nhờ các bác chỉnh sửa giùm em đoạn code này với ak. Hiện tại em tạo nút in trên sheet PYC luôn. Em muốn tạo 1 form in dữ liệu, khi nhấn Button16_click thì sẽ hiện form in và in dữ liệu ở sheet PYC. Em làm đủ cách mà không ra. Em có đính kèm Form in dữ liệu.
 

File đính kèm

  • IN PYC.jpg
    IN PYC.jpg
    14.2 KB · Đọc: 3
Upvote 0
kilypi đã viết:
Sub Button16_click()
Dim printFrom As Integer, printTo As Integer, I As Integer
Dim Ra As Range
'================================

printFrom = Sheets("PYC").Range("AG3").Value 'STT bat dau
printTo = Sheets("PYC").Range("AG4").Value 'STT ket thuc

'================================

For I = printFrom To printTo
Sheets("PYC").Range("AG1").Value = I
Sheets("PYC").PrintOut preview:=False
Next I
End Sub

Nhờ các bác chỉnh sửa giùm em đoạn code này với ak. Hiện tại em tạo nút in trên sheet PYC luôn. Em muốn tạo 1 form in dữ liệu, khi nhấn Button16_click thì sẽ hiện form in và in dữ liệu ở sheet PYC. Em làm đủ cách mà không ra. Em có đính kèm Form in dữ liệu.
Nhấp chuột vào đây để mở rộng...
Thay vì đính kèm cái ảnh kia bạn đính kèm File thì đã nhận hàng chục câu trả lời rồi
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
6
Đọc
95
vanlinh_2904
V
phatnguyen7301
  • Question Question
Viết code không trùng dữ liệu
Trả lời
1
Đọc
45
BuiQuangThuan
B
Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ
Trả lời
5
Đọc
71
Manhhung90
Manhhung90
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước.
Trả lời
3
Đọc
86
hanhnguyen12022021
H
N
Không chạy được file VBA
Trả lời
2
Đọc
87
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
214
Đọc
159K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
81
VetMini
V
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
68
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT
Trả lời
0
Đọc
122
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
174
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
148
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
303
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect
Trả lời
18
Đọc
278
HeSanbi
HeSanbi
NguyenNgocThuHien
  • Question Question
Liệt kê tổ hợp chập k của nhóm n phần tử.
    • Thích
    • Yêu thích
2 3
Trả lời
54
Đọc
17K
phương Đức
P
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
111
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
197
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
151
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
50
thuytrangbp28
T
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom