Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

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

PacificPR · 29/9/17

vova2209 đã viết:
Em chỉ muốn copy số lượng sheet thôi ạ! Code sẽ phải sửa như nào ạ

Vậy thì em không biết dâu. Cài này em chưa học và chưa từng làm

HieuCD · 29/9/17

PacificPR đã viết:
Vậy thì em không biết dâu. Cài này em chưa học và chưa từng làm

xem phần Help: InputBox Function

vova2209 · 29/9/17

HieuCD đã viết:
xem phần Help: InputBox Function

vâng cảm ơn anh!

trinhvinhtai · 30/9/17

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 đỡ.

GIUP MÌNH VỚI

sondaubac · 4/10/17

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

Ba Tê · 5/10/17

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
..........................

Bạn xem thử file này coi sao.

sondaubac · 5/10/17

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

chisinhvnn · 5/10/17

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.

Horse · 5/10/17

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.

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

chisinhvnn · 5/10/17

hpkhuong đã viết:
Chi khổ vậy bạn. Sao không viết công thức thắng vào sheet. chỉ là 3 cột nhân với nhau thôi mà...:

Cộng từng mục nữa mà anh

chisinhvnn · 5/10/17

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

Cảm ơn bạn.

Hoang2013 · 5/10/17

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.

sondaubac · 5/10/17

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

sondaubac · 5/10/17

Ô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

chisinhvnn · 5/10/17

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.

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.

NguyenNgocThuHien · 5/10/17

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.

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.

Hoang2013 · 5/10/17

Ờ, 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!

chisinhvnn · 6/10/17

Hoang2013 đã viết:
Ờ, 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!

Anh chỉ thêm em cách dùng hàm isnumeric với

anhkhoa1984 · 8/10/17

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.

Hoang2013 · 8/10/17

Anh chỉ thêm em cách dùng hàm isnumeric với

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

thaofluenly · 8/10/17

Nhờ cả nhà giúp mình. Mình cần xóa 1 số cột nhất định trong file csv. Mình sử dụng Code: ActiveSheet.Range("B:B,D:K,M: P,S:AH,AK:AM,AT:BO").EntireColumn.Delete
Tuy nhiên mình có khá nhiều file cần xóa các cột trên. Hiện tại mình đang phải mở từng file và chạy code trên. Mình muốn nhờ cả nhà giúp mình sửa code để làm sao nó chạy được cho nhiều file trong 1 folder nhất định nào đó.
Nếu được sau khi xóa các cột trên, mình muốn insert thêm 1 cột bên trái cột E, và điền ô E1 = "Item" thì mình thêm đoạn code này có được không?
Columns("E:E").Select
Selection.insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "Item"
Cảm ơn cả nhà.

anhduongvotinh · 8/10/17

Tình hình là em đang cần lập một hàm đếm các số ô có mầu cùng và kèm theo được điều kiện cùng đó như khi dùng hàm coutif
ví dụ: như đếm số ô có mầu đỏ và có ký tự cuối cùng là T mà em loay hoay mãi chưa lập được ai lập dùm em với Tks

huongmuine · 10/10/17

Nhờ Anh Chị chỉ giúp trong đoạn code chỗ nào chưa đúng. Yêu cầu:
Tại sheet SDT: khi nhập số 1 vào AO2 sẽ lấy dữ liệu ở sheet Data ( kết quả theo như sheet SDT )
Xin cảm ơn.

Ba Tê · 10/10/17

huongmuine đã viết:
Nhờ Anh Chị chỉ giúp trong đoạn code chỗ nào chưa đúng. Yêu cầu:
Tại sheet SDT: khi nhập số 1 vào AO2 sẽ lấy dữ liệu ở sheet Data ( kết quả theo như sheet SDT )
Xin cảm ơn.

Râu Ông này cắm cằm Bà kia???

huongmuine · 10/10/17

Ba Tê đã viết:
Râu Ông này cắm cằm Bà kia???

Xin cảm ơn Thầy ạ.

tueyennhi · 12/10/17

Trong file đính kèm em có phân lịch trực mỗi người. Tuy nhiên còn vướng mắc ở việc nếu hôm thứ nhất, người thứ nhất trực sáng thì hôm thứ 2 người thứ 2 trực phải là chiều. Anh chị tháo gỡ giúp em nhé.

Ba Tê · 12/10/17

tueyennhi đã viết:
Trong file đính kèm em có phân lịch trực mỗi người. Tuy nhiên còn vướng mắc ở việc nếu hôm thứ nhất, người thứ nhất trực sáng thì hôm thứ 2 người thứ 2 trực phải là chiều. Anh chị tháo gỡ giúp em nhé.

Bạn xếp thủ công hoàn thiện cả bảng thử xem ý bạn là thế nào?
Đọc "hôm thứ nhất, người thứ nhất trực sáng thì hôm thứ 2 người thứ 2 trực phải là chiều." chẳng hiểu bạn muốn gì.

tueyennhi · 12/10/17

Ba Tê đã viết:
Bạn xếp thủ công hoàn thiện cả bảng thử xem ý bạn là thế nào?
Đọc "hôm thứ nhất, người thứ nhất trực sáng thì hôm thứ 2 người thứ 2 trực phải là chiều." chẳng hiểu bạn muốn gì.

Nghĩa là lịch trực sẽ là các ngày từ thứ 2 đến 7, chủ nhật Off. Lịch trực sẽ xen kẽ buổi sáng và buổi chiều. Nếu hôm trước trực là sáng thì hôm sau phải là chiều. Và cái trực sáng chiều này chia đều cho tất cả mọi người anh ạ.

vm0fK-reCroVTUeRkSIgGX3Vadg-DeMpdOAk5vssIj7FM9XXuPmf0SLSIFGg2eKx4ddKUQ_YKpewNrMX5HSsMyfKFi0nZGOQ0Ke3oS1Mc0a1JXerERYGcV_ZHTNWqMUcANePofG9I5aDQ7Y-ZhqxyTdzMOOyQBfYBzdq594ecFh3FvATt1MqfeZdpe2wpqz0fvNz8QcDMcoH0kr90PMeHKSqDhPi7cTCZl6IBbqQisJ1Dxi3oVzMEECi86XsPTYH_bCRncvRhwLrTqleCwanA7dxwUVJCDrzjOQOcjhwB2uL_O5aHxDroENF4ibQ1dStgnkPv2J_IYoNTGXVzw5xr_YWtZ6HBEWSBbHEMoRM9uSPj480C8GWgIexq9Sc9eEwffrYQLtsqB2x0AlA6Y7rBPRatGSjAOdNg8xMGuX8IPIA_WP8QwaaNRH8rWOmDlOORfz2nxpehqzONOIdec84jcy5T_aPzp9siFxYr8IgRZpLf2Tp1QYZvGhmchSx5ouKD4F_5CcmVLEIaOOC805OUbtzGLswodnJHUV-Zt2jV1Gv7Tk-z4QNXSdlLV4XhqgQLYOF8htFz_jkAgVCheXS0_jw-qgWOXcva3Asge8ow2LAB7vAFROa_N14YCaOCFU8udHW048Mue3hxRqrjLRQLpOaQ04hpmMwvqsJZwlhrQPeiiPJ52IKYC_DRUIu=w908-h204-l75-ft

tueyennhi · 12/10/17

Lạ nhỉ, em gửi đính kèm ảnh phân ca cho anh xem, ban đầu thấy hiện rồi giờ vào lại thành dấu x. Em gửi lại file nhé.

HieuCD · 12/10/17

tueyennhi đã viết:
Lạ nhỉ, em gửi đính kèm ảnh phân ca cho anh xem, ban đầu thấy hiện rồi giờ vào lại thành dấu x. Em gửi lại file nhé.

Mã:

Public Sub XepLich()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, s As Long
sArr = Range("D5:AH10").Value
ReDim dArr(1 To 5, 1 To 31)
For J = 1 To 31
    If sArr(1, J) = 1 Then
        For I = 1 To 5
            dArr(I, J) = "Off"
        Next I
    Else
        s = s + 1
        If sArr(1, J) > 1 Then
            If K = 5 Then K = 1 Else K = K + 1
            If s Mod 2 = 1 Then dArr(K, J) = "Sang" Else dArr(K, J) = "Chieu"
        End If
    End If
Next J
[D6:AH10] = dArr
End Sub

vova2209 · 12/10/17

Thưa thầy! cho em hỏi gán 1 sub vào code:
call GPE và để nguyên GPE
Em thấy vẫn hoạt động bình thường, có gì khác nhau không ạ?

HieuCD · 12/10/17

vova2209 đã viết:
Thưa thầy! cho em hỏi gán 1 sub vào code:
call GPE và để nguyên GPE
Em thấy vẫn hoạt động bình thường, có gì khác nhau không ạ?

Mở Help xem

haitramy · 12/10/17

Nhờ mọi người xem giúp đoạn codec sau lỗi ở chỗ nào mà không chạy được:
Function xm(ByVal quy As Long, ByVal nam As Long)
Dim sArray
sArray = ThisWorkbook.Sheets("Data").Range("B3:F5").Value
xm = sArray(nam, quy)
End Function

ChanhTQ@ · 12/10/17

Vậy bạn có dịch sang tiếng Việt nội dung của hàm không?

& quan trọng là không fải nó chạy khơi khơi, mà cung cấp cho ,hàm những tham biến gì để nó chạy

NguyenNgocThuHien · 12/10/17

haitramy đã viết:
Nhờ mọi người xem giúp đoạn codec sau lỗi ở chỗ nào mà không chạy được:
Function xm(ByVal quy As Long, ByVal nam As Long)
Dim sArray
sArray = ThisWorkbook.Sheets("Data").Range("B3:F5").Value
xm = sArray(nam, quy)
End Function

Lần đầu thấy có người viết cái hàm độc kiểu này, với cái hàm này thì dùng hàm index trong excel cho nhanh, Gửi file lên sẽ có nhiều thông tin hơn.

befaint · 12/10/17

haitramy đã viết:
lỗi ở chỗ nào mà không chạy được

Lỗi như nào?

PHP:

Function TenHamLamGiDo(Byval Rng as range, ByVal quy As Long, ByVal nam As Long)
if Rng.Count=1 then exit Function
TenHamLamGiDo=Rng.Value(nam,quy)
End Function

Áp dụng bảng tính:

Mã:

=TenHamLamGiDo(vùng dữ liệu, nam, quy)

ChanhTQ@ · 12/10/17

Đâu có cần file cơ chứ!
Theo mình hiểu thì hàm cần cung cấp 2 tham biến là số nguyên dương; Trong đó 1 tham biến fải chỉ là từ 1 đến 3 Còn tham biến kia là từ 1 đến 5

Nếu cung ứng các tham biến sai fạm vi nó sẽ nói là "Đi chõ khác chơi đi bạn!"

PHP:

       (Cột B) (Cột C) (Cột D) (Cột E) {Cột F)
                Q I     QII     QIII    Q IV
(Hàng 3) 2016    100     415     451     487
(Hàng 4) 2017     45     200     355     510
(Hàng 5) 2018     32     322     612     902

NguyenNgocThuHien · 12/10/17

befaint đã viết:
Rng.Count=1

Nếu vùng rng không đúng yêu cầu thì nên trả lại lỗi, chứ ai lại "bỏ chạy".

acmen87 · 12/10/17

Các sư phụ giải thích giúp em đoạn code này với ạ
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$3" Then
Dim sht As Worksheet, rng As Range
If Len([e3]) > 8 Then Set sht = Sheet2 Else Set sht = Sheet3
With sht
Set rng = .Range(.[B7], .Cells(.Rows.Count, "B").End(3)).Find([E4], , xlValues, xlWhole, , , True)
If rng Is Nothing Then
[e10] = 0
GoTo thoat
End If
Application.EnableEvents = False
[e10].Value = rng(, [e6] + 2).Value

End With
End If
thoat:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

ChanhTQ@ · 13/10/17

acmen87 đã viết:
Các sư phụ giải thích giúp em đoạn code này với ạ
[ph]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
1 If Target.Address = "$E$3" Then
Dim sht As Worksheet, rng As Range
3 If Len([e3]) > 8 Then Set sht = Sheet2 Else Set sht = Sheet3
With sht
5 Set rng = .Range(.[B7], .Cells(.Rows.Count, "B").End(3)).Find([E4], , xlValues, xlWhole, , , True)
If rng Is Nothing Then
7 [e10] = 0
GoTo thoat
9 End If
Application.EnableEvents = False
11 [e10].Value = rng(, [e6] + 2).Value
End With
13 End If
thoat: Application.EnableEvents = True
End Sub[/php]

Dòng 0: Giới thiệu với bạn đây là macro sự kiện;
D1: Nếu (bạn vừa) đụng vào [E3] thì các dòng lệnh trước D13 được thi hành;
D2: Xác định 2 biến đối tượng sẽ được xài;
D3: Nếu chiều dài (chuỗi ) dữ liệu chứa trong [e3] hơn 8 thì gán Sheet2 vô biến đối tượng; bằng ngược lại thì (gán) sheet3
D4: Tuyên cáo làm việc với biến đối tượng (vừa được gán)
D5: Áp dụng fương thức Find (tìm kiếm) đến vùng có dữ liệu của cột [B:b] trong biến đội tượng để tìm trị trong ô [E4];
Cách tưức tìm là tìm dữ liệu (không fải tìm trong công tưức) & tìm theo nguyên thể (. . .);
D6: Nếu tìm không thấy thì thực hiện các lệnh trước D9;
D7: Gán trị 0 cho ô [E10];
D8: Tới nhãn có tên (. .)
D9 Ket thúc điều kiện xử lý (Xem lại D6)
D10: Không "chơi" nữa;
D11: (Muốn hiểu dòng lệnh này fải xem trong [E6] đang chứa gì mới được; Nhưng cách viết vầy hơi lạ!)
D12: Dứt tuyên cáo (D4)
D13: Kết thúc sự kiện
D14: Trả lại thiết lập ban đầu (của hệ thống)

Những mong giúp được bạn điều gì đó, nhỏ nhoi!

tueyennhi · 13/10/17

HieuCD đã viết:

Mã:

Public Sub XepLich()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, s As Long
sArr = Range("D5:AH10").Value
ReDim dArr(1 To 5, 1 To 31)
For J = 1 To 31
    If sArr(1, J) = 1 Then
        For I = 1 To 5
            dArr(I, J) = "Off"
        Next I
    Else
        s = s + 1
        If sArr(1, J) > 1 Then
            If K = 5 Then K = 1 Else K = K + 1
            If s Mod 2 = 1 Then dArr(K, J) = "Sang" Else dArr(K, J) = "Chieu"
        End If
    End If
Next J
[D6:AH10] = dArr
End Sub

Tài thật!!! Code của bạn dễ hiểu dễ vận dụng vào trường hợp khác. Cảm ơn rất nhiều!

kiencang76 · 13/10/17

không biết lỗi chỗ nào ?
Sub loc_du_lieu()
Dim cb As Range
Dim maxd As Range
For Each cb In Sheet3.Range("a1:a33") ' khai báo điều kiện lọc 1 ở đây
For Each maxd In Sheet3.Range("b1:b15") ' khai báo điều kiện lọc 2 ở đây
With Sheet2.Range("a1735") 'khai báo vùng lọc ở đây
.Parent.AutoFilterMode = False
.AutoFilter
.AutoFilter Field:=5, Criteria1:=cb
.AutoFilter Field:=14, Criteria1:=maxd
.Parent.AutoFilter.Range.Copy

Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cb & "-" & maxd
Sheets(Sheets.Count).Range("a1").PasteSpecial.xlPasteValues
End With
Next
1. tình hình là mình muốn viết 1 macro nhằm tách các sheet và đặt tên cho nó. Mình đã làm đúng như hướng dãn song chỉ chay được 01 sheet đầu tiên.
Còn sau đó thì nó báo lỗi run-time error '424"
2. Nếu như mình muốn khai báo điều kiện lọc, vùng lọc khi chạy macro thì phải làm như thế nào ạ
nếu chọn 1 hoặc 2 điều kiện thì macro sẽ chạy tương ứng với kiểu lọc

Thật sự thì mình gà về VBA. Mong các bạn chỉ giáo.https://drive.google.com/open?id=0B_i2RtK5k81fVzlRU1BuaWpVSkE

vova2209 · 15/10/17

Thưa thầy em muốn tìm số lớn nhất
DK: 2-:- 3 của cột A tìm số lớn nhất vùng cột E thì phải làm như nào, em cảm ơn thầy!
----------------------------
Dim arr, Rng As Range, Nmax As Long
Set Rng = .Range("E3", .Range("E65535").End(xlUp))
Nmax = Application.Max(Rng)
For i = 1 To Nmax
----> Nmax tìm dc lớn nhất là 11)

ChanhTQ@ · 15/10/17

Chuyện đầu tiên, mình khẳng định không là thầy ai cả.

Chuyện kế tiếp: Cần fải hiểu sao cho đúng câu này của bạn:

DK: 2-:- 3 của cột A tìm số lớn nhất vùng cột E thì phải làm như nào

(1) Tìm số lớn nhất tại cột [E:e], khi cột [A:a] có trị là 2 hay 3

(2) Tìm các giá trị lớn nhất (ở cột [E:E] khi trị tại cột [A:A] thay đổi

(3) . . . . . . .

vova2209 · 15/10/17

ChanhTQ@ đã viết:
Chuyện đầu tiên, mình khẳng định không là thầy ai cả.

Chuyện kế tiếp: Cần fải hiểu sao cho đúng câu này của bạn:

(1) Tìm số lớn nhất tại cột [E:e], khi cột [A:a] có trị là 2 hay 3

(2) Tìm các giá trị lớn nhất (ở cột [E:E] khi trị tại cột [A:A] thay đổi

(3) . . . . . . .

Dạ vâng!
(1) Tìm số lớn nhất tại cột [E:e], khi cột [A:a] có trị từ >= 2 đến <= 3 (VD như hình: điều kiện cần tìm trong vùng Cột A từ 2 đến 6 tìm giá trị lớn nhất tại cột E sẽ tìm được là 8)

)

vova2209 · 15/10/17

HieuCD đã viết:
Mở Help xem

Có phải giống như thay vì .End(3) ta viết thành .End(xlUp) thì nhìn sẽ trực Quan hơn phải ko anh?

befaint · 15/10/17

vova2209 đã viết:
(1) Tìm số lớn nhất tại cột [E:e], khi cột [A:a] có trị từ >= 2 đến <= 3 (VD như hình: điều kiện cần tìm trong vùng Cột A từ 2 đến 6 tìm giá trị lớn nhất tại cột E sẽ tìm được là 8)

Mã:

=AGGREGATE(14,6,(vungdk>=canduoi)*(vungdk<=cantren)*vungcanlay_kq,1)

vova2209 · 15/10/17

befaint đã viết:
Mã:

=AGGREGATE(14,6,(vungdk>=canduoi)*(vungdk<=cantren)*vungcanlay_kq,1)

Em muốn code vba để làm thành function gán vào Biến Nmax ở code dưới ạ

vova2209 đã viết:
Dim arr, Rng As Range, Nmax As Long
Set Rng = .Range("E3", .Range("E65535").End(xlUp))
Nmax = Application.Max(Rng)
For i = 1 To Nmax

befaint · 15/10/17

vova2209 đã viết:
code vba

WorksheetFunction.

vova2209 · 15/10/17

befaint đã viết:
WorksheetFunction.

là hàm sẵn của excel nhập vào worksheetFunction. l chứ không phải tạo 1 cấu trúc hàm riêng phải ko anh?

HieuCD · 15/10/17

vova2209 đã viết:
Có phải giống như thay vì .End(3) ta viết thành .End(xlUp) thì nhìn sẽ trực Quan hơn phải ko anh?

Đại khái là vậy, viết đầy đủ dể đọc hơn, ngoài ra trong help Call còn có tác dụng gì đó mà mình không biết rỏ
Vấn đề gì mình không biết, tự tra phần Help, tìm trên mạng, tự thử nhiều lần theo nhiều cách, kỹ năng sẽ được nâng cao
Cách tìm Max

Mã:

Nmax=0
For i=1 to gì đó
  if điều kiện xét then
    if Nmax<Arr(... , ....) then Nmax=Arr(... , ....)
  end if
Next i

vova2209 · 15/10/17

befaint đã viết:
Mã:

=AGGREGATE(14,6,(vungdk>=canduoi)*(vungdk<=cantren)*vungcanlay_kq,1)

Anh ơi! em dùng ofice 2007 không có hàm đó ạ. Bác viết dùm em với, file bên dưới

vova2209 · 15/10/17

HieuCD đã viết:
Đại khái là vậy, viết đầy đủ dể đọc hơn, ngoài ra trong help Call còn có tác dụng gì đó mà mình không biết rỏ
Vấn đề gì mình không biết, tự tra phần Help, tìm trên mạng, tự thử nhiều lần theo nhiều cách, kỹ năng sẽ được nâng cao
Cách tìm Max

Mã:

Nmax=0 For i=1 to gì đó if điều kiện xét then if Nmax<Arr(... , ....) then Nmax=Arr(... , ....) end if Next i

Anh làm ví dụ cho em với ạ!

HieuCD · 15/10/17

vova2209 đã viết:
Anh làm ví dụ cho em với ạ!

dùng công thức

vova2209 · 15/10/17

HieuCD đã viết:
dùng công thức

anh ơi! viết hộ em đoạn code để em add vào sub của em ạ! em cảm ơn a

HieuCD · 15/10/17

vova2209 đã viết:
anh ơi! viết hộ em đoạn code để em add vào sub của em ạ! em cảm ơn a

chạy code Test

Mã:

Sub Test()
  Dim Nmax As Long, Lrow As Long, iMin As Long, iMax As Long
  iMin = 2
  iMax = 3
  With Sheets("TH-K95")
    Lrow = .Range("A" & Rows.Count).End(xlUp).Row
    Nmax = IfMax(.Range("A3:A" & Lrow), .Range("E3:E" & Lrow), iMin, iMax)
    MsgBox ("Max là: " & Nmax)
  End With
End Sub

Private Function IfMax(ByVal ifRng As Range, ByVal MaxRng As Range, ByVal iMin As Long, ByVal iMax As Long)
  Dim i As Long, Nmax As Long
  For i = 1 To ifRng.Rows.Count
    If ifRng(i, 1) >= iMin And ifRng(i, 1) <= iMax Then
      If Nmax < MaxRng(i, 1) Then Nmax = MaxRng(i, 1)
    End If
  Next i
  IfMax = Nmax
End Function

vova2209 · 15/10/17

HieuCD đã viết:

chạy code Test

Mã:

Sub Test()
  Dim Nmax As Long, Lrow As Long, iMin As Long, iMax As Long
  iMin = 2
  iMax = 3
  With Sheets("TH-K95")
    Lrow = .Range("A" & Rows.Count).End(xlUp).Row
    Nmax = IfMax(.Range("A3:A" & Lrow), .Range("E3:E" & Lrow), iMin, iMax)
    MsgBox ("Max là: " & Nmax)
  End With
End Sub

Private Function IfMax(ByVal ifRng As Range, ByVal MaxRng As Range, ByVal iMin As Long, ByVal iMax As Long)
  Dim i As Long, Nmax As Long
  For i = 1 To ifRng.Rows.Count
    If ifRng(i, 1) >= iMin And ifRng(i, 1) <= iMax Then
      If Nmax < MaxRng(i, 1) Then Nmax = MaxRng(i, 1)
    End If
  Next i
  IfMax = Nmax
End Function

Code chạy ổn rồi ạ! em cảm ơn anh nhiều.. Chúc anh 1 ngày vui vẻ

acmen87 · 15/10/17

ChanhTQ@ đã viết:
Dòng 0: Giới thiệu với bạn đây là macro sự kiện;
D1: Nếu (bạn vừa) đụng vào [E3] thì các dòng lệnh trước D13 được thi hành;
D2: Xác định 2 biến đối tượng sẽ được xài;
D3: Nếu chiều dài (chuỗi ) dữ liệu chứa trong [e3] hơn 8 thì gán Sheet2 vô biến đối tượng; bằng ngược lại thì (gán) sheet3
D4: Tuyên cáo làm việc với biến đối tượng (vừa được gán)
D5: Áp dụng fương thức Find (tìm kiếm) đến vùng có dữ liệu của cột [B:b] trong biến đội tượng để tìm trị trong ô [E4];
Cách tưức tìm là tìm dữ liệu (không fải tìm trong công tưức) & tìm theo nguyên thể (. . .);
D6: Nếu tìm không thấy thì thực hiện các lệnh trước D9;
D7: Gán trị 0 cho ô [E10];
D8: Tới nhãn có tên (. .)
D9 Ket thúc điều kiện xử lý (Xem lại D6)
D10: Không "chơi" nữa;
D11: (Muốn hiểu dòng lệnh này fải xem trong [E6] đang chứa gì mới được; Nhưng cách viết vầy hơi lạ!)
D12: Dứt tuyên cáo (D4)
D13: Kết thúc sự kiện
D14: Trả lại thiết lập ban đầu (của hệ thống)

Những mong giúp được bạn điều gì đó, nhỏ nhoi!

anh ơi có thể cho em trao đổi riêng hỏi thêm chút không anh? em k pm hồ sơ anh đc ạ

ChanhTQ@ · 15/10/17

Bạn nên nêu câu hỏi trên diễn đàn;
Có vậy bạn sẽ nhận được câu trả lời chính xác hơn từ cộng đồng.

vova2209 · 16/10/17

ChanhTQ@ đã viết:
Bạn nên nêu câu hỏi trên diễn đàn;
Có vậy bạn sẽ nhận được câu trả lời chính xác hơn từ cộng đồng.

dạ vâng anh! nhiều khi ý diên

acmen87 đã viết:
anh ơi có thể cho em trao đổi riêng hỏi thêm chút không anh? em k pm hồ sơ anh đc ạ

Dạ vâng! em xin cảm ơn a đã góp ý.. em sẽ còn học hỏi và rút kinh nghiệm nhiều nữa.. cảm ơn anh và gpe rất nhiều!

kiencang76 · 16/10/17

kiencang76 đã viết:
không biết lỗi chỗ nào ?
Sub loc_du_lieu()
Dim cb As Range
Dim maxd As Range
For Each cb In Sheet3.Range("a1:a33") ' khai báo điều kiện lọc 1 ở đây
For Each maxd In Sheet3.Range("b1:b15") ' khai báo điều kiện lọc 2 ở đây
With Sheet2.Range("a1735") 'khai báo vùng lọc ở đây
.Parent.AutoFilterMode = False
.AutoFilter
.AutoFilter Field:=5, Criteria1:=cb
.AutoFilter Field:=14, Criteria1:=maxd
.Parent.AutoFilter.Range.Copy

Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cb & "-" & maxd
Sheets(Sheets.Count).Range("a1").PasteSpecial.xlPasteValues
End With
Next
1. tình hình là mình muốn viết 1 macro nhằm tách các sheet và đặt tên cho nó. Mình đã làm đúng như hướng dãn song chỉ chay được 01 sheet đầu tiên.
Còn sau đó thì nó báo lỗi run-time error '424"
2. Nếu như mình muốn khai báo điều kiện lọc, vùng lọc khi chạy macro thì phải làm như thế nào ạ
nếu chọn 1 hoặc 2 điều kiện thì macro sẽ chạy tương ứng với kiểu lọc

Thật sự thì mình gà về VBA. Mong các bạn chỉ giáo.https://drive.google.com/open?id=0B_i2RtK5k81fVzlRU1BuaWpVSkE

sao không có ai giúp vậy nè huhu

vova2209 · 16/10/17

HieuCD đã viết:

chạy code Test

Mã:

Sub Test()
  Dim Nmax As Long, Lrow As Long, iMin As Long, iMax As Long
  iMin = 2
  iMax = 3
  With Sheets("TH-K95")
    Lrow = .Range("A" & Rows.Count).End(xlUp).Row
    Nmax = IfMax(.Range("A3:A" & Lrow), .Range("E3:E" & Lrow), iMin, iMax)
    MsgBox ("Max là: " & Nmax)
  End With
End Sub

Private Function IfMax(ByVal ifRng As Range, ByVal MaxRng As Range, ByVal iMin As Long, ByVal iMax As Long)
  Dim i As Long, Nmax As Long
  For i = 1 To ifRng.Rows.Count
    If ifRng(i, 1) >= iMin And ifRng(i, 1) <= iMax Then
      If Nmax < MaxRng(i, 1) Then Nmax = MaxRng(i, 1)
    End If
  Next i
  IfMax = Nmax
End Function

anh ơi! có thể ghép hẳn thành 1 function được không ạ..
Để em cho vào Nmax vào vòng for code của em giúp em với

vova2209 · 16/10/17

kiencang76 đã viết:
sao không có ai giúp vậy nè huhu

Bỏ đoạn này đi là đc bạn
Sheet3.

Bạn nên gửi cả file lên như vậy tương tác trực tiếp sẽ dễ hơn!

acmen87 · 16/10/17

ChanhTQ@ đã viết:
Bạn nên nêu câu hỏi trên diễn đàn;
Có vậy bạn sẽ nhận được câu trả lời chính xác hơn từ cộng đồng.

Anh ơi anh cho em hỏi khi viết liền code như sau:
"Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$3" Then
Dim sht As Worksheet, rng As Range
If Len([e3]) > 8 Then Set sht = Sheet2 Else Set sht = Sheet3
With sht
Set rng = .Range(.[B7], .Cells(.Rows.Count, "B").End(3)).Find([E4], , xlValues, xlWhole, , , True)
Application.EnableEvents = False
If rng Is Nothing Then
[e10] = 0
GoTo thoat
End If
[e10].Value = rng(, [e6] + 2).Value

End With
End If
thoat:
Application.EnableEvents = True
End Sub"
với là tách ra viết 2 đoạn khác nhau như sau:
- trong sheet viết:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$4" Then GPE Target.Value
End Sub
- trong module viết:
"
Sub GPE(Gt)
On Error Resume Next
Dim i As Long, k As Long
Dim Arr, dArr, sArr
Arr = Range(Sheet3.[B10], Sheet3.[B65000].End(3)).Resize(, 12)
ReDim dArr(1 To UBound(Arr, 1), 1 To 1)
ReDim sArr(1 To UBound(Arr, 1), 1 To 1)
k = 0
For i = 1 To UBound(Arr, 1)
If Year(Arr(i, 12)) = Gt Then
k = k + 1
dArr(k, 1) = Arr(i, 1)
sArr(k, 1) = Arr(i, 12)
End If
Next i
Sheet5.Range("B6:B20").ClearContents
Sheet5.Range("B6").Resize(k) = dArr
Sheet5.Range("G6:G20").ClearContents
Sheet5.Range("G6").Resize(k) = sArr
End Sub" nó sẽ khác nhau thế nào ạ???

HieuCD · 16/10/17

vova2209 đã viết:
anh ơi! có thể ghép hẳn thành 1 function được không ạ..
Để em cho vào Nmax vào vòng for code của em giúp em với

đã tạo Function rồi, còn sub Test chỉ là ví dụ thôi

acmen87 · 17/10/17

HieuCD đã viết:
đã tạo Function rồi, còn sub Test chỉ là ví dụ thôi

anh ơi xem hộ em câu hỏi trên vs ạ

ChanhTQ@ · 17/10/17

Hai macro trên làm 2 công việc với 2 cách hoàn toàn khác nhau; Vậy sẽ khó trả lời đầy đủ cho iêu cầu của bạn rồi.

Tạm thời là vầy:

Macro GPE() được cung cấp bỡi 1 tham biến Gt; Nó là tham biến chỉ ra con số của 1 năm nào đó
Trong macro này nó sẽ so sánh tham biến được cung cấp với từng dòng của mảng; Nếu trùng với trị trong cột 12 của dòng biến mảng đang khảo sát thì làm thứ gì đó;
Thứ gì đó ở đây là ghi số liệu cột nào đó của dòng đang khảo sát vô các mảng đã khai báo cho bạn.

Thường người ta tách ra thành 1 chương trình con để:
Dễ bảo trì, sửa chữa
Làm việc linh hoạt hơn với tham biến tương ứng được cung cấp khác nhau

Lấy ví dụ macro được cung cấp 2 tham biến,
1 vẫn là Gt, & thêm tham biến thứ 2 là trị mang/ứng với số cột ( trong macro trên là cột 12 giả dụ là ngày vô; còn cột 13 là ngày ra. . .)
Thì bạn sẽ thấy rằng, macro GPE sẽ làm việc khác nhau khi nhận các tham biến khác nhau tương ứng.

Tạm thời chỉ vậy, nếu bạn cần ví dụ cụ thể hơn thì chờ đi vậy!

kiencang76 · 17/10/17

vova2209 đã viết:
Bỏ đoạn này đi là đc bạn
Sheet3.

Bạn nên gửi cả file lên như vậy tương tác trực tiếp sẽ dễ hơn!

nếu bỏ sheet3. thì nó lấy điều kiện ở đâu bạn ơi
ok, lần sau rút kinh nghiệm vụ gởi cả files trực tiếp. không gởi link.
cảm ơn bạn

vova2209 · 17/10/17

kiencang76 đã viết:
nếu bỏ sheet3. thì nó lấy điều kiện ở đâu bạn ơi
ok, lần sau rút kinh nghiệm vụ gởi cả files trực tiếp. không gởi link.
cảm ơn bạn

Code yêu cầu bên trên gửi file lại là loại khác thì làm sao mà dc bạn?
Bạn phải đưa code vào mục code [.QUOTE] code [./QUOTE]

sonan · 18/10/17

Mọi người cho hỏi. Excel có cách nào tự giãn dòng khi đánh văn bản như word k. Word tự động căn chỉnh nên các dòng thẳng hàng lề bên phải. Excel lượn lề bên phải như rắn

befaint · 18/10/17

sonan đã viết:
Mọi người cho hỏi. Excel có cách nào tự giãn dòng khi đánh văn bản như word k. Word tự động căn chỉnh nên các dòng thẳng hàng lề bên phải. Excel lượn lề bên phải như rắn

Có chứ. Bạn ráng tìm là thấy thôi.

huuthang_bd · 18/10/17

befaint đã viết:
Có chứ. Bạn ráng tìm là thấy thôi.

Có cái nào chỉ giùm đi bạn. Tôi tìm lâu lắm rồi mà chưa có cái nào đúng cả.

sonan · 18/10/17

huuthang_bd đã viết:
Có cái nào chỉ giùm đi bạn. Tôi tìm lâu lắm rồi mà chưa có cái nào đúng cả.

T làm bên hs thi công. Chỉ vì cái này nên vẫn dùng mailmerger word

befaint · 18/10/17

huuthang_bd đã viết:
Có cái nào chỉ giùm đi bạn. Tôi tìm lâu lắm rồi mà chưa có cái nào đúng cả.

Híc. Kèo thơm bị khóa bài rồi anh.

Còn cái canh lề của bạn hỏi ở trên.
1. Excel có cách nào tự giãn dòng khi đánh văn bản như word: Giãn theo phương đứng hoặc phương ngang.

2. Word tự động căn chỉnh nên các dòng thẳng hàng lề bên phải. Excel lượn lề bên phải như rắn: Theo phương ngang.

Từ 1+2, suy luận cần canh lề theo phương ngang. Excel có Alignment, Horizontal, Justify + Wrap Text.

Ví dụ:

tueyennhi · 18/10/17

Em có đoạn code sau

.Range("J8").Resize(K, 125)

Làm thế nào để định dạng số cho mảng này. Ví dụ 1000000 thành 1.000.000

befaint · 18/10/17

tueyennhi đã viết:
Làm thế nào để định dạng số cho mảng này. Ví dụ 1000000 thành 1000.000

Record macro là có ngay.

tueyennhi · 18/10/17

befaint đã viết:
Record macro là có ngay.

Heeeeeee, có luôn. Cảm ơn befaint. Ban đầu mình dùng Format không được. Hóa ra phải là NumberFormat

PHP:

.Range("EF2").Resize(1, 26).NumberFormat = "#.##0"

huuthang_bd · 18/10/17

tueyennhi đã viết:
Heeeeeee, có luôn. Cảm ơn befaint. Ban đầu mình dùng Format không được. Hóa ra phải là NumberFormat

PHP:

.Range("EF2").Resize(1, 26).NumberFormat = "#,##0"

Vậy mà được 1000.000 sao?

tueyennhi · 18/10/17

huuthang_bd đã viết:
Vậy mà được 1000.000 sao?

1,000,000. Hề, lỗi lỗi.

trungcr105 · 19/10/17

Chào mọi người em đang gặp khó với VBA mong mọi người giúp đỡ với ah!

em muốn làm phần Hyperlink trong cột "File" thì phải làm thế nào ah, em mày mò hoài mà không ra được phần đó.
Em tự mày mò nên cũng chỉ biết hạn chế, mong mọi người giúp đỡ ah
em xin chân thành cảm ơn!

haukidien · 19/10/17

Chào mọi người. Em có 1 file excel dùng code để in cho nhanh! (file đính kèm)Nhưng mỗi lần in chỉ đc 1 bộ.
Nhờ mọi người chỉ cho em thêm 1 đoạn code để có thể thiết lập in được nhiều bộ với chỉ 1 lần click nút print ( ví dụ in 7 bộ)
Thanks mọi người!
Pass VBA: 123

tueyennhi · 19/10/17

PHP:

Dim i As Integer, j As Integer
Dim r1 As Integer, r2 As Integer

HR = Sheets("HR").Range("A8:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim K_HR(1 To UBound(HR, 1), 1 To 1)
For i = 1 To UBound(HR, 1)
    If HR(i, 1) = 9 Then
        r1 = r1 + 1
        K_HR(r1, 1) = HR(i, 2)
    End If
    MsgBox r1
Next i
If r1 Then
Sheets("Report").Range("R1").Resize(r1, 1) = K_HR
End If
End Sub

Cho em hỏi code này sai ở đâu? Nếu tại sheet HR em chạy thì r1 lần lượt hiện tại msgbox là 1 2 3 và 4. Nhưng nếu chạy tại sheet Report thì kết quả hoàn toàn khác, msgbox lần lượt là 0 0 0 và 1.

HieuCD · 19/10/17

tueyennhi đã viết:
PHP:

Dim i As Integer, j As Integer Dim r1 As Integer, r2 As Integer HR = Sheets("HR").Range("A8:B" & Range("B" & Rows.Count).End(xlUp).Row).Value ReDim K_HR(1 To UBound(HR, 1), 1 To 1) For i = 1 To UBound(HR, 1) If HR(i, 1) = 9 Then r1 = r1 + 1 K_HR(r1, 1) = HR(i, 2) End If MsgBox r1 Next i If r1 Then Sheets("Report").Range("R1").Resize(r1, 1) = K_HR End If End Sub

Cho em hỏi code này sai ở đâu? Nếu tại sheet HR em chạy thì r1 lần lượt hiện tại msgbox là 1 2 3 và 4. Nhưng nếu chạy tại sheet Report thì kết quả hoàn toàn khác, msgbox lần lượt là 0 0 0 và 1.

HR = Sheets("HR").Range("A8:B" &Sheets("HR"). Range("B" & Rows.Count).End(xlUp).Row).Value

tueyennhi · 19/10/17

HieuCD đã viết:
HR = Sheets("HR").Range("A8:B" &Sheets("HR"). Range("B" & Rows.Count).End(xlUp).Row).Value

Chạy ngon lành rồi anh ạ. Nhưng làm thế nào để chuyển cái "dọc" thành cái "ngang" anh? Kết quả đang trả về là một cột nhiều dòng, em muốn thành 1 dòng nhiều cột thì làm như nào ạ?

HieuCD · 19/10/17

tueyennhi đã viết:
Chạy ngon lành rồi anh ạ. Nhưng làm thế nào để chuyển cái "dọc" thành cái "ngang" anh? Kết quả đang trả về là một cột nhiều dòng, em muốn thành 1 dòng nhiều cột thì làm như nào ạ?

thử code

Mã:

HR = Sheets("HR").Range("A8:B" &Sheets("HR"). Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim K_HR( 1 To 1, 1 To UBound(HR, 1))
For i = 1 To UBound(HR, 1)
    If HR(i, 1) = 9 Then
        r1 = r1 + 1
        K_HR(1, r1) = HR(i, 2)
    End If
    MsgBox r1
Next i
If r1 Then
Sheets("Report").Range("R1").Resize(, r1) = K_HR
End If

haukidien · 19/10/17

Sub print_td()
Dim p1, p2, i&
p1 = Sheet15.Range("P2").Value
p2 = Sheet15.Range("P3").Value

If IsNumeric(p1) = False Or IsNumeric(p2) = False Then
tb = MsgBox("So code phai la so.", , "Thông báo")
Exit Sub
End If

If p1 > p2 Then
tb = MsgBox("So code sau phai >= so code truoc.", , "Thông báo")
Exit Sub
End If

If p1 < 1 Or p2 < 1 Then
tb = MsgBox("So code phai >= 1.", , "Thông báo")
Exit Sub
End If

If p1 <= p2 Then
For i = p1 To p2
Sheet15.Range("O1").Value = i
Sheet15.PrintOut
Next
End If

End Sub

Cho em xin thêm 1 dòng code để giá trị i lặp lại n lần theo ô "P4" ở sheet15 với ạ!
For i = p1 To p2
Sheet15.Range("O1").Value = i
Sheet15.PrintOut

HieuCD · 19/10/17

haukidien đã viết:
Cho em xin thêm 1 dòng code để giá trị i lặp lại n lần theo ô "P4" ở sheet15 với ạ!
For i = p1 To p2
Sheet15.Range("O1").Value = i
Sheet15.PrintOut

Thử lệnh
MyString = String(5, "*") ' Returns "*****"

haukidien · 19/10/17

HieuCD đã viết:
Thử lệnh
MyString = String(5, "*") ' Returns "*****"

cho nó vào vị trí nào a? a chèn dùm cho em với, cái này em gà lắm! thansk a

HieuCD · 19/10/17

haukidien đã viết:
cho nó vào vị trí nào a? a chèn dùm cho em với, cái này em gà lắm! thansk a

nói rỏ lại câu:
"Cho em xin thêm 1 dòng code để giá trị i lặp lại n lần theo ô "P4" ở sheet15 với ạ!"
và cho ví vụ cụ thể

haukidien · 19/10/17

HieuCD đã viết:
nói rỏ lại câu:
"Cho em xin thêm 1 dòng code để giá trị i lặp lại n lần theo ô "P4" ở sheet15 với ạ!"
và cho ví vụ cụ thể

Vâng, file excel của em như thế này. Em dùng vba print từ code 1 đến code 7, mỗi lần in chỉ đc 1 bộ. Giờ a có thể chèn giùm em thêm 1 đoạn code vào vba đó để em có thể đánh thêm 1 số là số bộ cần in (ví dụ cần in 7 lần, in từ code 1 đến 7, rồi lặp lại từ 1 đến 7 cho đến khi đủ 7 lần)

hoanghaivqg · 19/10/17

Em mới học vba và tạo được đoạn code . Chạy model "loc_du_lieu" thì không sao, nhưng chạy model "tan_suat_hd" thì excel tự tắt và khởi động lại. Mong mọi người giúp đỡ, gỡ rối giùm em ah. Thanks!

HieuCD · 19/10/17

haukidien đã viết:
Vâng, file excel của em như thế này. Em dùng vba print từ code 1 đến code 7, mỗi lần in chỉ đc 1 bộ. Giờ a có thể chèn giùm em thêm 1 đoạn code vào vba đó để em có thể đánh thêm 1 số là số bộ cần in (ví dụ cần in 7 lần, in từ code 1 đến 7, rồi lặp lại từ 1 đến 7 cho đến khi đủ 7 lần)

Lệnh điều khiển máy in mình không rành, dùng tạm code

Mã:

Sub preview_td()
Dim p1 As Long, p2 As Long, n As Long, i As Long, j As Long
p1 = Sheet2.Range("P2").Value
p2 = Sheet2.Range("P3").Value
n = Sheet2.Range("P5").Value 'so bo can in
If IsNumeric(p1) = False Or IsNumeric(p2) = False Or IsNumeric(n) = False Then
  tb = MsgBox("So code va so bo can in phai la so.", , "Thông báo")
  Exit Sub
End If

If p1 > p2 Then
  tb = MsgBox("So code sau phai >= so code truoc.", , "Thông báo")
  Exit Sub
End If

If p1 < 1 Then
  tb = MsgBox("So code phai >= 1.", , "Thông báo")
  Exit Sub
End If

If n < 1 Then
  tb = MsgBox("So bo can in phai >= 1.", , "Thông báo")
  Exit Sub
End If

For i = p1 To p2
  Sheet2.Range("O1").Value = i
  For j = 1 To n
     'Sheet2.PrintOut
     Sheet2.PrintPreview
  Next j
Next

End Sub

haukidien · 19/10/17

HieuCD đã viết:

Lệnh điều khiển máy in mình không rành, dùng tạm code

Mã:

Sub preview_td()
Dim p1 As Long, p2 As Long, n As Long, i As Long, j As Long
p1 = Sheet2.Range("P2").Value
p2 = Sheet2.Range("P3").Value
n = Sheet2.Range("P5").Value 'so bo can in
If IsNumeric(p1) = False Or IsNumeric(p2) = False Or IsNumeric(n) = False Then
  tb = MsgBox("So code va so bo can in phai la so.", , "Thông báo")
  Exit Sub
End If

If p1 > p2 Then
  tb = MsgBox("So code sau phai >= so code truoc.", , "Thông báo")
  Exit Sub
End If

If p1 < 1 Then
  tb = MsgBox("So code phai >= 1.", , "Thông báo")
  Exit Sub
End If

If n < 1 Then
  tb = MsgBox("So bo can in phai >= 1.", , "Thông báo")
  Exit Sub
End If

For i = p1 To p2
  Sheet2.Range("O1").Value = i
  For j = 1 To n
     'Sheet2.PrintOut
     Sheet2.PrintPreview
  Next j
Next

End Sub

Cảm ơn anh cái code này, đã in đc số lượng bộ nhiều. Nhưng nó ko in 1 lượt từ "p1" đến "p2" mà nó in "p1" 7 lần rồi "p2" 7 lần. Anh có thể chỉnh lại code này sao cho nó in 1 lượt từ p1 đến p2 rồi lặp lại p1 đến p2 với số lần là n đc không ạ? Thanks anh!

HieuCD · 19/10/17

haukidien đã viết:
Cảm ơn anh cái code này, đã in đc số lượng bộ nhiều. Nhưng nó ko in 1 lượt từ "p1" đến "p2" mà nó in "p1" 7 lần rồi "p2" 7 lần. Anh có thể chỉnh lại code này sao cho nó in 1 lượt từ p1 đến p2 rồi lặp lại p1 đến p2 với số lần là n đc không ạ? Thanks anh!

Chỉnh lại đoạn cuối

Mã:

For j = 1 To n
  For i = p1 To p2
    Sheet2.Range("O1").Value = i
    'Sheet2.PrintOut
    Sheet2.PrintPreview
  Next i
Nextj

acmen87 · 19/10/17

Các huynh cho em hỏi code dò dữ liệu theo 2 điều kiện. trong ví dụ thì như sau:
sheet ck sẽ là dữ liệu ban đầu có sẵn
trong sheet chenh lech thì i8 và i9 sẽ là điều kiện để lọc dữ liệu. i10 sẽ là kết quả. trong đó i10 sẽ thỏa mãn các điều kiện sau:
i10 là ô trong sheet ck là giao của hàng có giá trị là giá trị đang ở i8 và cột đang chứa giá trị của i9. E cảm ơn các anh ạ

gaconlonton7 · 20/10/17

SA_DQ · 20/10/17

acmen87 đã viết:
Em hỏi code dò dữ liệu theo 2 điều kiện. trong ví dụ thì như sau:
sheet ck sẽ là dữ liệu ban đầu có sẵn
trong sheet chenh lech thì i8 và i9 sẽ là điều kiện để lọc dữ liệu. i10 sẽ là kết quả. trong đó i10 sẽ thỏa mãn các điều kiện sau:
i10 là ô trong sheet ck là giao của hàng có giá trị là giá trị đang ở i8 và cột đang chứa giá trị của i9.

Viết hẵn cho bạn 1 hàm tự tạo luôn, đây:

PHP:

Function SoChuyen(MaDV As String, Tháng As Integer)
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Set Sh = ThisWorkbook.Worksheets("CK")
 Set Rng = Sh.Columns("B:b")
 Set sRng = Rng.Find(MaDV, , xlFormulas, xlWhole)
 If sRng Is Nothing Then
    SoChuyen = "Nothing"
 Else
    SoChuyen = sRng.Offset(, Tháng).Value
    If SoChuyen = "" Then SoChuyen = "GPE.COM"
 End If
End Function

acmen87 · 20/10/17

SA_DQ đã viết:

Viết hẵn cho bạn 1 hàm tự tạo luôn, đây:

PHP:

Function SoChuyen(MaDV As String, Tháng As Integer)
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Set Sh = ThisWorkbook.Worksheets("CK")
 Set Rng = Sh.Columns("B:b")
 Set sRng = Rng.Find(MaDV, , xlFormulas, xlWhole)
 If sRng Is Nothing Then
    SoChuyen = "Nothing"
 Else
    SoChuyen = sRng.Offset(, Tháng).Value
    If SoChuyen = "" Then SoChuyen = "GPE.COM"
 End If
End Function

tks bạn, để mình thử ạ

hoanghaivqg · 20/10/17

Mọi người cho em hỏi ah: em chạy code nhưng excel tự động tắt là sao ah? mặc dù chạy code khác thì bình thường. Giúp em với ah!
Em chạy trên cả 2 office 2007 và 2010 đều không được ah.

SA_DQ · 20/10/17

Em chạy code nhưng excel tự động tắt là sao ah? mặc dù chạy code khác thì bình thường. Giúp em với ah!
Em chạy trên cả 2 office 2007 và 2010 đều không được ah.

Vậy thì 1 trong 2 thứ í bị bệnh nặng lắm rồi: Excel hay Code của bạn!
Nếu là do Excel, thì cài lại;
Nếu là do Code thì nên đưa lên diễn đàn để i bác sỹ hội chẩn cho.

Chúc vui!

Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

Người dùng đang xem chủ đề này

Huyền thoại GPE

Thành viên mới

Chuyên gia GPE

Thành viên tích cực

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

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

File đính kèm

Thành viên hoạt động

File đính kèm

Thành viên tiêu biểu

File đính kèm

Thành viên mới

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

Thành viên tiêu biểu

Cute Black Cat

Thành viên gắn bó

Thành viên tiêu biểu

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên GPE

File đính kèm

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

File đính kèm

Thành viên GPE

Thành viên tích cực

File đính kèm

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

Thành viên tích cực

Thành viên tích cực

File đính kèm

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

Thành viên mới

0901452không62

Cute Black Cat

|||||||||||||

0901452không62

Cute Black Cat

Thành viên chính thức

0901452không62

Thành viên tích cực

Thành viên mới

Thành viên tích cực

0901452không62

Thành viên tích cực

Thành viên tích cực

|||||||||||||

Thành viên tích cực

|||||||||||||

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

File đính kèm

Thành viên tích cực

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

Thành viên chính thức

0901452không62

Thành viên tích cực

Thành viên mới

Thành viên tích cực

Thành viên tích cực

Thành viên chính thức

Chuyên gia GPE