Chuyên mục xử lý, gỡ rối code VBA (2 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
trinhvinhtai đã viết:
Public Sub GPE()
Dim Arr(), i As Integer, vArr()
Arr = Range("b2:m" & Range("m65000").End(xlUp).Row).Value
ReDim vArr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
vArr(i, 1) = Application.Evaluate(Arr(i, 1) & "/" & Arr(i, 12) & "*" & Arr(i, 2)) 'chia 8: 8 day so co dinh trong code luôn'
Next i
Range("d2").Resize(UBound(Arr)) = vArr

End Sub

chao e muốn thêm code này vArr(i, 1) = Application.Evaluate(Arr(i, 1) & "/" & Arr(i, 12) & "*" & Arr(i, 2))/8 số 8 tô màu đó là cố định trong code luôn.

câu @: e mun xai code hàm if cho e xin code hàm if với.

mong mọi người giúp đỡ.
Nhấp chuột vào đây để mở rộng...
GIUP MÌNH VỚI
 
Upvote 0
Nhờ các bạn kiểm tra dùm mình bị lỗi chỗ nào mà khi sử dụng sự kiện worksheet_change trong sheet XuatDL ở các Cells trong cột B thì nó tra cứu được theo mảng nhưng mà mất giá trị đầu tiên

Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Dulieu, Ketqua, I As Long, K As Long, Ivl As Long, Inc As Long, Imay As Long
    Dim VL As String, Nc As String, May As String, LaMa As Long
    Dim Ma As String, Mahieu As String
VL = "V" & ChrW$(7853) & "t li" & ChrW$(7879) & "u"
Nc = "Nh" & ChrW$(226) & "n c" & ChrW$(244) & "ng"
May = "M" & ChrW$(225) & "y"
On Error Resume Next
If Not Intersect(Target, [B7:B10000]) Is Nothing Then
    If Target.Count = 1 Then
        Mahieu = Sheets("XuatDL").Range("B" & Target.Row)
        With Sheets("CSDL DM")
            Dulieu = .Range("B5", .Range("B65535").End(3)).Resize(, 6)                  ' Chon vung DL dinh muc tu o B5 den G...
        End With
        ReDim Ketqua(1 To UBound(Dulieu), 1 To 6)
     
        For I = 1 To UBound(Dulieu)
     
            Ma = Dulieu(I, 1)           ' Ma = Ma hieu cong viec o cot 1 cua Mang DuLieu
         
            If Ma = Mahieu Then
         
                K = K + 1
             
                If K = 1 Then               ' Chay dong dau tien, tim ten CV, DVT, KL = 1
             
                    Ketqua(K, 2) = "=VLOOKUP(RC[-2],'CSDL tenCV'!R5C2:R1800C4,2,0)"     ' Tim ten CV trong CSDL tenCV
                    Ketqua(K, 3) = "=VLOOKUP(RC[-3],'CSDL tenCV'!R5C2:R1800C4,3,0)"     ' Tim DVT cua cong viec trong CSDL tenCV
                    Ketqua(K, 4) = 1                                                    ' Gan Khoi luong = 1
                End If
             
             
                If K > 1 Then               ' Chay dong thu 2, xuat mang KET QUA tu mang Du Lieu
                 
                    If Dulieu(I, 4) = VL Then                                        ' Neu cot so 4 cua sheet CSDL DM la VAT LIEU thi lam ....
                        Ivl = Ivl + 1
                        If Ivl = 1 Then
                            Ketqua(K, 2) = ChrW(97) & "). " & VL                        ' Danh chu a). Vat Lieu
                            K = K + 1
                        End If
                        Ketqua(K, 1) = Dulieu(I, 2): Ketqua(K, 2) = Dulieu(I, 5): Ketqua(K, 5) = Dulieu(I, 3)
                    End If
                 
                    If Dulieu(I, 4) = Nc Then
                        Inc = Inc + 1
                        If Inc = 1 Then
                            Ketqua(K, 2) = ChrW(98) & "). " & Nc                        ' Danh chu b). Nhan Cong
                            K = K + 1
                        End If
                        Ketqua(K, 1) = Dulieu(I, 2):  Ketqua(K, 2) = Dulieu(I, 5): Ketqua(K, 5) = Dulieu(I, 3)
                    End If
                 
                    If Dulieu(I, 4) = May Then
                        Imay = Imay + 1
                        If Imay = 1 Then
                            Ketqua(K, 2) = ChrW(99) & "). " & May                       ' Danh chu c). May
                            K = K + 1
                        End If
                        Ketqua(K, 1) = Dulieu(I, 2): Ketqua(K, 2) = Dulieu(I, 5): Ketqua(K, 5) = Dulieu(I, 3)
                    End If
                End If
            End If
        Next I
        If K Then
            Target.Offset(, 1).Resize(K, 5) = Ketqua
            Range("A" & Target.Row & ":G" & Target.Row).Resize(K).Borders.LineStyle = 1
            Range("A" & Target.Row & ":G" & Target.Row).Resize(K).Borders(xlInsideHorizontal).Weight = xlHairline
        Else
            MsgBox "Khong tim thay"
        End If
    End If
End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
sondaubac đã viết:
Nhờ các bạn kiểm tra dùm mình bị lỗi chỗ nào mà khi sử dụng sự kiện worksheet_change trong sheet XuatDL ở các Cells trong cột B thì nó tra cứu được theo mảng nhưng mà mất giá trị đầu tiên
..........................
Nhấp chuột vào đây để mở rộng...
Bạn xem thử file này coi sao.
 

File đính kèm

Upvote 0
Mã: 
Private Sub cmdNhapLieu_Click()
Dim ApMH As Range
Dim x As Integer

    Set ApMH = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)   ' Chon o bat dau dien du lieu
   
    For x = 0 To Me.LBox_DATAtenCV.ListCount - 1                    ' LBox_DATAtenCV la ten cua list box ma chung ta chon trong form
                                                                    ' Cho x chay tu dong so 0 den dong so cuoi cung cua ListBox -1 (tuc la cho i chay tu dong dau den dong cuoi List Box)
                                                                   
        If Me.LBox_DATAtenCV.Selected(x) Then                       ' Neu lua chon dong thu x+1 thi
       
            ApMH = Me.LBox_DATAtenCV.List(x)                        ' Gan ApMh la vung du lieu cua dong thu x+1
            ApMH.Offset(0, 0) = Me.LBox_DATAtenCV.List(x, 1)        ' Gan ApMh dong 1 cot 1 là vung du lieu LIST BOX dong x+1 cot 1
            ApMH.Offset(0, 1) = Me.LBox_DATAtenCV.List(x, 2)        ' Gan ApMh dong 1 cot 2 là vung du lieu LIST BOX dong x+1 cot 2
            ApMH.Offset(0, 2) = Me.LBox_DATAtenCV.List(x, 3)        ' Gan ApMh dong 1 cot 3 là vung du lieu LIST BOX dong x+1 cot 3

            Set ApMH = ApMH.Offset(1, 0)                            ' Cho ApMh di chuyen xuong 1 dong
        End If
    Next x
    For x = 0 To Me.LBox_DATAtenCV.ListCount - 1
        If Me.LBox_DATAtenCV.Selected(x) Then Me.LBox_DATAtenCV.Selected(x) = False
    Next x
    Unload formTraMH
End Sub
Check dùm mình cái Form nhập dữ liệu bên sheet KHOI LUONG với, sao nó lại không chạy được nhỉ?
Nhờ các bạn chỉ giúp mình lỗi sai chỗ nào với
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mã: 
Public Sub tinhtien2() 'GPE
Dim sArr(), dArr(), I As Long, R As Long, tong As Double
lr = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
sArr = Sheet3.Range("A6:F" & lr).Value
R = UBound(sArr)
Application.ScreenUpdating = False
ReDim dArr(1 To R, 1 To 1)
For I = R To 1 Step -1
    If sArr(I, 1) = Empty Then
        dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)
          
   
        tong = tong + dArr(I, 1)
    Else
        dArr(I, 1) = Application.WorksheetFunction.Round(tong, -3): tong = 0
  
    End If
Next I
Sheet3.Range("G5") = "=Round(SUM(R[1]C:R[" & R & "]C)/2,-3)"
Sheet3.Range("G6").Resize(UBound(sArr)) = dArr
Application.ScreenUpdating = True
End Sub
Mình dùng iferror để bẩy lỗi các cột có giá trị là chữ (hoặc trống) nhưng khi chạy code vẫn bị báo lỗi.
Mã: 
  "dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)"
Nhờ GPE giúp đỡ mình với.
 

File đính kèm

Upvote 0
chisinhvnn đã viết:
Mã: 
Public Sub tinhtien2() 'GPE
Dim sArr(), dArr(), I As Long, R As Long, tong As Double
lr = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
sArr = Sheet3.Range("A6:F" & lr).Value
R = UBound(sArr)
Application.ScreenUpdating = False
ReDim dArr(1 To R, 1 To 1)
For I = R To 1 Step -1
    If sArr(I, 1) = Empty Then
        dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)
         
  
        tong = tong + dArr(I, 1)
    Else
        dArr(I, 1) = Application.WorksheetFunction.Round(tong, -3): tong = 0
 
    End If
Next I
Sheet3.Range("G5") = "=Round(SUM(R[1]C:R[" & R & "]C)/2,-3)"
Sheet3.Range("G6").Resize(UBound(sArr)) = dArr
Application.ScreenUpdating = True
End Sub
Mình dùng iferror để bẩy lỗi các cột có giá trị là chữ (hoặc trống) nhưng khi chạy code vẫn bị báo lỗi.
Mã: 
  "dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)"
Nhờ GPE giúp đỡ mình với.
Nhấp chuột vào đây để mở rộng...
Anh thử sửa lại như thế này xem
HTML: 
Public Sub tinhtien2()
    Dim sArr(), dArr(), I As Long, R As Long, tong As Double
On Error Resume Next
lr = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
sArr = Sheet3.Range("A6:F" & lr).Value
R = UBound(sArr)
Application.ScreenUpdating = False
ReDim dArr(1 To R, 1 To 1)
For I = R To 1 Step -1
    If sArr(I, 1) = Empty Then
        dArr(I, 1) = Application.WorksheetFunction.Product(sArr(I, 4), sArr(I, 5), sArr(I, 6))
        tong = tong + dArr(I, 1)
    Else
        dArr(I, 1) = Application.WorksheetFunction.Round(tong, -3): tong = 0
    End If
Next I
Sheet3.Range("G5") = "=Round(SUM(R[1]C:R[" & R & "]C)/2,-3)"
Sheet3.Range("G6").Resize(UBound(sArr)) = dArr
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Horse đã viết:
Anh thử sửa lại như thế này xem
HTML: 
Public Sub tinhtien2()
    Dim sArr(), dArr(), I As Long, R As Long, tong As Double
On Error Resume Next
lr = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
sArr = Sheet3.Range("A6:F" & lr).Value
R = UBound(sArr)
Application.ScreenUpdating = False
ReDim dArr(1 To R, 1 To 1)
For I = R To 1 Step -1
    If sArr(I, 1) = Empty Then
        dArr(I, 1) = Application.WorksheetFunction.Product(sArr(I, 4), sArr(I, 5), sArr(I, 6))
        tong = tong + dArr(I, 1)
    Else
        dArr(I, 1) = Application.WorksheetFunction.Round(tong, -3): tong = 0
    End If
Next I
Sheet3.Range("G5") = "=Round(SUM(R[1]C:R[" & R & "]C)/2,-3)"
Sheet3.Range("G6").Resize(UBound(sArr)) = dArr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu là mình thì xài IsNumeric(); Tuy dài nhưng chắc không báo lỗi.

Còn vẫn thích Application thì thử với hàm N() xem sao.
 
Upvote 0
Các bạn xem dùm mình sao cái User Form này chạy cứ báo lỗi với.
Đúng tên ListBox rồi mà sao nó cứ báo overflow ở dòng
For x = 0 To Me.LBoxDATAtenCV.ListCount - 1

Code của mình
Mã: 
Private Sub cmdNhapLieu_Click()
Dim ApMH As Range
Dim x As Integer

    Set ApMH = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)   ' Chon o bat dau dien du lieu
    
    For x = 0 To Me.LBoxDATAtenCV.ListCount - 1                    ' LBox_DATAtenCV la ten cua list box ma chung ta chon trong form
                                                                    ' Cho x chay tu dong so 0 den dong so cuoi cung cua ListBox -1 (tuc la cho i chay tu dong dau den dong cuoi List Box)
                                                                    
        If Me.LBoxDATAtenCV.Selected(x) Then                       ' Neu lua chon dong thu x+1 thi
        
            ApMH = Me.LBoxDATAtenCV.List(x)                        ' Gan ApMh la vung du lieu cua dong thu x+1
            
            ApMH.Offset(0, 0) = Me.LBoxDATAtenCV.List(x, 1)        ' Gan ApMh dong 1 cot 1 là vung du lieu LIST BOX dong x+1 cot 1
            ApMH.Offset(0, 1) = Me.LBoxDATAtenCV.List(x, 2)        ' Gan ApMh dong 1 cot 2 là vung du lieu LIST BOX dong x+1 cot 2
            ApMH.Offset(0, 2) = Me.LBoxDATAtenCV.List(x, 3)        ' Gan ApMh dong 1 cot 3 là vung du lieu LIST BOX dong x+1 cot 3
 
            Set ApMH = ApMH.Offset(1, 0)                            ' Cho ApMh di chuyen xuong 1 dong
        End If
    Next x
    For x = 0 To Me.LBoxDATAtenCV.ListCount - 1
        If Me.LBoxDATAtenCV.Selected(x) Then Me.LBoxDATAtenCV.Selected(x) = False
    Next x
    Unload formTraMH
End Sub
 

File đính kèm

Upvote 0
Ôi vừa hỏi xong thì lại làm được.
Hóa ra mình sai ở chỗ thừa 1 dòng dữ liệu

Mã: 
Private Sub cmdNhapLieu_Click()
Dim ApMH As Range
Dim x As Long

    Set ApMH = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)   ' Chon o bat dau dien du lieu
    
    For x = 0 To Me.LBoxDATAtenCV.ListCount - 1                     ' LBox_DATAtenCV la ten cua list box ma chung ta chon trong form
                                                                    ' Cho x chay tu dong so 0 den dong so cuoi cung cua ListBox -1 (tuc la cho i chay tu dong dau den dong cuoi List Box)
                                                                    
        If Me.LBoxDATAtenCV.Selected(x) Then                       ' Neu lua chon dong thu x+1 thi
        
            ApMH.Offset(0, 0) = Me.LBoxDATAtenCV.List(x, 0)        ' Gan ApMh dong 1 cot 1 la vung du lieu LIST BOX dong x+1 cot 1
            ApMH.Offset(0, 1) = Me.LBoxDATAtenCV.List(x, 1)        ' Gan ApMh dong 1 cot 2 là vung du lieu LIST BOX dong x+1 cot 2
            ApMH.Offset(0, 2) = Me.LBoxDATAtenCV.List(x, 2)        ' Gan ApMh dong 1 cot 3 là vung du lieu LIST BOX dong x+1 cot 3

 
            Set ApMH = ApMH.Offset(1, 0)                            ' Cho ApMh di chuyen xuong 1 dong
        End If
    Next x
    For x = 0 To Me.LBoxDATAtenCV.ListCount - 1
        If Me.LBoxDATAtenCV.Selected(x) Then Me.LBoxDATAtenCV.Selected(x) = False
    Next x
    Unload formTraMH
End Sub
 
Upvote 0
Hoang2013 đã viết:
Nếu là mình thì xài IsNumeric(); Tuy dài nhưng chắc không báo lỗi.

Còn vẫn thích Application thì thử với hàm N() xem sao.
Nhấp chuột vào đây để mở rộng...
Anh nói rõ hơn giúp em với được không. "Application thì thử với hàm N() xem sao".
Còn dùng IsNumeric() vụ này em chưa biết đến. Để em xem theem cái này. Cảm ơn anh.
 
Upvote 0
chisinhvnn đã viết:
Mã: 
Public Sub tinhtien2() 'GPE
Dim sArr(), dArr(), I As Long, R As Long, tong As Double
lr = Sheet3.Cells(Rows.Count, "B").End(xlUp).Row
sArr = Sheet3.Range("A6:F" & lr).Value
R = UBound(sArr)
Application.ScreenUpdating = False
ReDim dArr(1 To R, 1 To 1)
For I = R To 1 Step -1
    If sArr(I, 1) = Empty Then
        dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)
         
  
        tong = tong + dArr(I, 1)
    Else
        dArr(I, 1) = Application.WorksheetFunction.Round(tong, -3): tong = 0
 
    End If
Next I
Sheet3.Range("G5") = "=Round(SUM(R[1]C:R[" & R & "]C)/2,-3)"
Sheet3.Range("G6").Resize(UBound(sArr)) = dArr
Application.ScreenUpdating = True
End Sub
Mình dùng iferror để bẩy lỗi các cột có giá trị là chữ (hoặc trống) nhưng khi chạy code vẫn bị báo lỗi.
Mã: 
  "dArr(I, 1) = Application.WorksheetFunction.IfError(sArr(I, 4) * sArr(I, 5) * sArr(I, 6), 0)"
Nhờ GPE giúp đỡ mình với.
Nhấp chuột vào đây để mở rộng...

Khi thực hiện phép nhân bị lỗi thì nó sẽ ngắt ngay, hàm iferror sẽ chưa có cơ hội để chạy. Excel là excel, vba là vba, không dùng lẫn lộn được đâu.
 
Upvote 0
Ờ, Hàm N() chỉ xài được trong VBA với câu lệnh ví dụ là vầy:
Mã: 
Sub Macro1()
    Range("J7").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]*N(RC[-5])"
   
End Sub

Mình xin lỗi bạn vì chưa kĩ lưỡng!
 
Upvote 0
Mọi người cho mình hỏi cách tăng số cột của listbox ???.
Mình có làm 1 form nhập liệu. Gồm 1 số textbox để nhập dữ liêụ và 1 listbox lưu tạm dữ liệu.
Vấn đề là khi nhập liệu listbox mình chỉ lưu tạm tối đa được 9 cột. Nếu dùng rowsource thì nó lại load được hơn 23 cột.
Mình đang dùng office 2016 bản 64 bit.
 
Upvote 0
Anh chỉ thêm em cách dùng hàm isnumeric với
Nhấp chuột vào đây để mở rộng...
Thì vầy:
Nếu ta muốn có tích của 3 số hạng A, B & C, thì
PHP: 
 Dim GPE As Double
'. . . . . '
If Isnumeric(A) And Isnumeric(B) and Isnumweic(C) Then
   GPE= A * B * C
End If
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
214
Đọc
158K
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
51
VetMini
V
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
2
Đọc
42
hanhnguyen12022021
H
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
48
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT
Trả lời
0
Đọc
81
giaoluu1231
G
N
Không chạy được file VBA
Trả lời
1
Đọc
49
yaaasoo01
Y
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
155
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 (1 người xem)
Trả lời
7
Đọc
136
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
294
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
655
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • 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
258
HeSanbi
HeSanbi
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian (1 người xem)
Trả lời
7
Đọc
105
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
186
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
143
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
44
thuytrangbp28
T
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ
Trả lời
3
Đọc
93
hoangtuaotrang_hp_vn
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
324
Đọc
24K
vanthuan986
V
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
10
Đọc
1K
trung_bhxh
T
D
Chuyển đổi font chữ VNI-Time.
    • Cười
Trả lời
6
Đọc
495
vanle33
vanle33
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