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

th_kid2001 · 9/12/13

Nhờ các anh swar giúp em đoạn code sau:

Sub chon()
On Error GoTo 0
Dim p, p1 As Variant
Dim x, x1 As Double
Dim chon As String

On Error GoTo thoat
chon1:
Do
p = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon 1: ")
x = p(0)
MsgBox x
Loop

On Error GoTo thoat
chon2:
Do
p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon 2: ")
x1 = p1(0)
MsgBox x1
Loop

thoat:
chon = ThisDrawing.Utility.GetString(False, vbCrLf & " Chon lai ko? ")
If chon = "1" Then
GoTo chon1
ElseIf chon = "2" Then
GoTo chon2
Else
GoTo end_sub
End If
end_sub:
End Sub

Em cám ơn trước!

nam_lp86 · 17/12/13

Nhờ các anh chị giúp,

Sub Main()
Dim SrcRng As Range, Crit1 As Range, Crit2 As Range
With Sheets("Sheet1")
Set SrcRng = .Range(.[A6], .[A65536].End(xlUp)).Resize(, 50)
Set Crit1 = .Range("fi6:fi7")
End With
Sheets("Sheet2").Range("A:AX").Clear
SrcRng.AdvancedFilter 2, Crit1, Sheets("Sheet2").Range("A6")
Sheets("Sheet2").Select
End Sub

Em dùng đoạn code trên để tính ngày sinh nhật sau 1 tháng
vùng điều kiện Set Crit1 = .Range("fi6:fi7") em dùng công thức =IF(MONTH(TODAY())+1<=12,MONTH(TODAY())+1,1)=MONTH(G6)

Trong file số 1 thì vẫn tìm được các nhân viên với điều kiện trên, nhưng file số 2 thì không , link file bên dưới
http://www.mediafire.com/view/5878gnx4bclzcmp/a.xlsm
http://www.mediafire.com/view/l0ney16k53w0qwi/Copy of formNhanSu.xlsm

mhung12005 · 17/12/13

nam_lp86 đã viết:
Nhờ các anh chị giúp,

Sub Main()
Dim SrcRng As Range, Crit1 As Range, Crit2 As Range
With Sheets("Sheet1")
Set SrcRng = .Range(.[A6], .[A65536].End(xlUp)).Resize(, 50)
Set Crit1 = .Range("fi6:fi7")
End With
Sheets("Sheet2").Range("A:AX").Clear
SrcRng.AdvancedFilter 2, Crit1, Sheets("Sheet2").Range("A6")
Sheets("Sheet2").Select
End Sub

Em dùng đoạn code trên để tính ngày sinh nhật sau 1 tháng
vùng điều kiện Set Crit1 = .Range("fi6:fi7") em dùng công thức =IF(MONTH(TODAY())+1<=12,MONTH(TODAY())+1,1)=MONTH(G6)

Trong file số 1 thì vẫn tìm được các nhân viên với điều kiện trên, nhưng file số 2 thì không , link file bên dưới
http://www.mediafire.com/view/5878gnx4bclzcmp/a.xlsm
http://www.mediafire.com/view/l0ney16k53w0qwi/Copy of formNhanSu.xlsm

Code này là liệt kê những người sau 1 tháng với tháng hiện tại (chứ không phải tính).
Code của bạn viết hơi sai 1 chút. Sửa thành vầy là đc.

Mã:

Sub Main()  
  Dim SrcRng As Range, Crit As Range
  Set SrcRng = Sheet1.Range(Sheet1.[A5], Sheet1.[A65536].End(xlUp)).Resize(, 50)
  Application.ScreenUpdating = False
  With Sheet2
    Set Crit = .[H1:H2]
    .[A6:AX500].Clear
    SrcRng.AdvancedFilter 2, Crit, [A5:AX5]
  End With
  Application.ScreenUpdating = True
End Sub

Bạn thảo khảo file đính kèm nhé.

nam_lp86 · 18/12/13

Cảm ơn bạn mhung12005
Mục đích của mình trong sheet1 nhập toàn bộ dữ liệu nhân viên, có nút sinh nhật khi nhấn vào đó nó sẽ lọc các nhân viên đó sang sheet 2, tương tự như vậy ta làm nút hết hạn hợp đồng, trong file mình up bên trên file tên a.xlsm mình có làm được như thế nhưng cùng code đó mình làm file thứ 2 thì lại không được

nam_lp86 · 19/12/13

Nhờ các anh chị giúp
Em đã làm được phần sinh nhật rồi nhưng còn phần tìm thông tin nhân viên không hiểu sao lại không được
Em dùng đoạn code bên dưới
Sub Sinhnhat()
Dim SrcRng As Range, Crit1 As Range
With Sheets("Data")
Set SrcRng = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit1 = .Range("B2:B3")
End With
Sheets("SinhNhat").Range("A7:AX500").Clear
SrcRng.AdvancedFilter 2, Crit1, Sheets("SinhNhat").Range("A7")
Sheets("SinhNhat").Select
End Sub
Sub NhanVien()
Dim SrcRng1 As Range, Crit2 As Range
With Sheets("Data")
Set SrcRng1 = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit2 = .Range("C2:C3")
End With
Sheets("NhanVien").Range("A7:AX500").Clear
SrcRng1.AdvancedFilter 2, Crit2, Sheets("NhanVien").Range("A7")
Sheets("NhanVien").Select
End Sub

Link file đính kèm
http://www.mediafire.com/download/3cvmb958x4d8xds/formNhanSu.xlsm

buithanhlong · 19/12/13

Thêm cột số thứ tự

Chào các bác, đề tài này tôi gửi lên diễn đàn đã lâu mà không có ai giúp, tôi cho rằng có thể tôi đã gửi sai địa chỉ nên hôm nay tôi gửi lại lên đây, tôi không cố ý 1 bài gửi nhiều lần, rất mong các bác giúp đỡ, nếu có gì không đúng rất mong được chỉ giáo. Trân trọng biết ơn
Nội dung nhờ giúp đỡ: khi thêm cột số thứ tự thì bị lỗi, tôi đã thử chỉnh nhiều cách nhưng chưa được.

tvxdgt · 20/12/13

mình sưu tầm một đoạn code chọn thư mục như sau:

PHP:

Sub ChonDia_Click()
On Error GoTo err    
Application.FileDialog(msoFileDialogFolderPicker).Show    
Sheet1.txtPathe.Text = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1)
err:    
Exit Sub
End Sub

giờ mình muốn sủa chọn được luôn một file cụ thể .doc, .pdf, ...

hieuxd · 8/1/14

Nhờ mọi người giải thích giúp tại sao trong VBa lại cộng được ký tự nhỉ
Trong excel sử dụng toán tử lối chuỗi &

Mã:

Private Function DocChu(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
    s = ""
    For i = 1 To Len(so)
        c = Mid(so, i, 1)
        Select Case c
            Case "0": s = s + "kh" + ChrW(244) + "ng "
            Case "1": s = s + "m" + ChrW(7897) + "t "
            Case "2": s = s + "hai "
            Case "3": s = s + "ba "
            Case "4": s = s + "b" + ChrW(7889) + "n "
            Case "5": s = s + "n" + ChrW(259) + "m "
            Case "6": s = s + "s" + ChrW(225) + "u "
            Case "7": s = s + "b" + ChrW(7843) + "y "
            Case "8": s = s + "t" + ChrW(225) + "m "
            Case "9": s = s + "ch" + ChrW(237) + "n "
            Case ".", ",": s = s + "ph" + ChrW(7849) + "y "
        End Select
        MsgBox s
        DocChu = Trim(s)
    Next i
End Function

Mã:

Private Function DocRoi(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
    s = ""
    For i = 1 To Len(so)
        c = Mid(so, i, 1)
        Select Case c
            Case "0": s = s & "kh" & ChrW(244) & "ng "
            Case "1": s = s & "m" & ChrW(7897) & "t "
            Case "2": s = s & "hai "
            Case "3": s = s & "ba "
            Case "4": s = s & "b" & ChrW(7889) & "n "
            Case "5": s = s & "n" & ChrW(259) & "m "
            Case "6": s = s & "s" & ChrW(225) & "u "
            Case "7": s = s & "b" & ChrW(7843) & "y "
            Case "8": s = s & "t" & ChrW(225) & "m "
            Case "9": s = s & "ch" & ChrW(237) & "n "
            Case ".", ",": s = s & "ph" & ChrW(7849) & "y "
        End Select
        MsgBox s
        DocRoi = Trim(s)
    Next i
End Function

viehoai · 8/1/14

hieuxd đã viết:

Nhờ mọi người giải thích giúp tại sao trong VBa lại cộng được ký tự nhỉ
Trong excel sử dụng toán tử lối chuỗi &

Mã:

Private Function DocChu(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
    s = ""
    For i = 1 To Len(so)
        c = Mid(so, i, 1)
        Select Case c
            Case "0": s = s + "kh" + ChrW(244) + "ng "
            Case "1": s = s + "m" + ChrW(7897) + "t "
            Case "2": s = s + "hai "
            Case "3": s = s + "ba "
            Case "4": s = s + "b" + ChrW(7889) + "n "
            Case "5": s = s + "n" + ChrW(259) + "m "
            Case "6": s = s + "s" + ChrW(225) + "u "
            Case "7": s = s + "b" + ChrW(7843) + "y "
            Case "8": s = s + "t" + ChrW(225) + "m "
            Case "9": s = s + "ch" + ChrW(237) + "n "
            Case ".", ",": s = s + "ph" + ChrW(7849) + "y "
        End Select
        MsgBox s
        DocChu = Trim(s)
    Next i
End Function
[CODE]
Private Function DocRoi(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
    s = ""
    For i = 1 To Len(so)
        c = Mid(so, i, 1)
        Select Case c
            Case "0": s = s & "kh" & ChrW(244) & "ng "
            Case "1": s = s & "m" & ChrW(7897) & "t "
            Case "2": s = s & "hai "
            Case "3": s = s & "ba "
            Case "4": s = s & "b" & ChrW(7889) & "n "
            Case "5": s = s & "n" & ChrW(259) & "m "
            Case "6": s = s & "s" & ChrW(225) & "u "
            Case "7": s = s & "b" & ChrW(7843) & "y "
            Case "8": s = s & "t" & ChrW(225) & "m "
            Case "9": s = s & "ch" & ChrW(237) & "n "
            Case ".", ",": s = s & "ph" & ChrW(7849) & "y "
        End Select
        MsgBox s
        DocRoi = Trim(s)
    Next i
End Function[/QUOTE]
Giải thích thì chịu, ông Bill cho ta làm được thế thì cứ làm. Bạn có quyền thay dấu + bằng &

hieuxd · 8/1/14

viehoai đã viết:
Giải thích thì chịu, ông Bill cho ta làm được thế thì cứ làm. Bạn có quyền thay dấu + bằng &

Em thấy lạ khác thường nên hỏi vậy
Theo em thì đúng là dùng dấu & sẽ tường minh dễ hiểu hơn dùng dấu + trong trường hợp này
vì từ trước tới giờ vẫn dùng & để lối chuỗi khi sử dụng công thức và hàm trên bảng tính

viehoai · 8/1/14

hieuxd đã viết:
Em thấy lạ khác thường nên hỏi vậy
Theo em thì đúng là dùng dấu & sẽ tường minh dễ hiểu hơn dùng dấu + trong trường hợp này
vì từ trước tới giờ vẫn dùng & để lối chuỗi khi sử dụng công thức và hàm trên bảng tính

Nếu dùng dấu + thì cần cẩn thận hơn.
Ví dụ:
....
k=k+1
Msgbox k+chrW(244)
... Chắc chắn sẽ báo lỗi ngay.

sanhdieu0911 · 10/1/14

Giúp tớ sửa đoạn code này với nhé!

Trong lần trước tớ nhờ a e trên GPE viết hộ tớ 1 đoạn code.
Nhưng giờ công việc tớ có chút thay đổi, thế nên việc tính toán phải thêm vào .
Tớ đưa ra công thức cũ trong file word, mã code cũ trong word
và phần cuối là sửa công thức tính S mới và ô so sánh mới.
Mong mọi người giúp đỡ tớ nhé!

Kiều Mạnh · 12/1/14

Nhờ sửa lại code cho ngắn gọn hơn

mình đang sử dụng code sau để khi mình đang ở bất cứ sheet nào mà đóng file e xcel lại thì nó sẽ về sheet 6 còn các sheet khác ẩn hết. hiện vẩn sử dụng được nhưng nhìn vào thấy nó dài lê thê ..khó nhìn quá . nhờ các bạn rút ngắn lại dùm ...mình đang mày mò học lỏm code của GPE nên mới làm được vậy thôi đừng cười nha...
Mong Trợ Giúp
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Protect "123"
Sheet6.Select
Sheet1.Visible = 2
Sheet2.Visible = 2
Sheet3.Visible = 2
Sheet4.Visible = 2
Sheet5.Visible = 2
Sheet7.Visible = 2
Sheet8.Visible = 2
Sheet9.Visible = 2
Sheet10.Visible = 2
Sheet11.Visible = 2
Sheet12.Visible = 2
ThisWorkbook.Protect "123", Structure:=True
Me.Save
End Sub

akayzai1 · 12/1/14

Giải đáp code giùm em

Subdien()
Dim x As Double
Dim y As Double
x = Val(InputBox("nhap x = "))
y = Val(InputBox("nhap y = "))
If x > y Then
For i = y + 1 To x - 1
Cells(i, 1) = i
Next i
End If
If x < y Then
For i = x + 1 To y - 1
Cells(i, 1) = i
Next i
End If
Application.Columns(1).Select
For Each cell In Selection
If cell.Value Mod 2 = 0 Andcell.Value<> "" Then
cell.Interior.Color = vbGreen
End If
Next cell
End Sub
Bây giờ em muốn nhập 1 số âm , 1 số dương bất kỳ hoặc 2 số âm thì sửa code như thế nào các bác cho em ý kiến.

Quang_Hải · 12/1/14

kieu manh đã viết:
mình đang sử dụng code sau để khi mình đang ở bất cứ sheet nào mà đóng file e xcel lại thì nó sẽ về sheet 6 còn các sheet khác ẩn hết. hiện vẩn sử dụng được nhưng nhìn vào thấy nó dài lê thê ..khó nhìn quá . nhờ các bạn rút ngắn lại dùm ...mình đang mày mò học lỏm code của GPE nên mới làm được vậy thôi đừng cười nha...
Mong Trợ Giúp
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Protect "123"
Sheet6.Select
Sheet1.Visible = 2
Sheet2.Visible = 2
Sheet3.Visible = 2
Sheet4.Visible = 2
Sheet5.Visible = 2
Sheet7.Visible = 2
Sheet8.Visible = 2
Sheet9.Visible = 2
Sheet10.Visible = 2
Sheet11.Visible = 2
Sheet12.Visible = 2
ThisWorkbook.Protect "123", Structure:=True
Me.Save
End Sub

Code tạm vầy nha

PHP:

Sub yyy()
Dim Sh
ThisWorkbook.Unprotect "123"
For Each sh In Worksheets
   If sh.CodeName <> "Sheet6" Then
      sh.Visible = 2
   End If
Next
ThisWorkbook.Protect "123", Structure:=True
Application.DisplayAlerts = True
End Sub

ChanhTQ@ · 12/1/14

Bạn tham khảo macro này thử coi:

PHP:

Option Explicit
Sub DienDaySo()
Dim X As Double, Y As Double, Tmp As Double, J As Long
Dim Cls As Range, Rng As Range
 Columns("A:A").Clear
 X = Abs(Val(InputBox("nhap x = ")))
 Y = Abs(Val(InputBox("nhap y = ")))
1 ' Hoán Doi X & Y Ne1u Càn:'
 If Y <= X Then
    X = Tmp:               X = Y
    Y = Tmp
 End If
 
 For J = X + 1 To Y
    Cells(J, 1) = J
 Next J
 Set Rng = Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
 
 For Each Cls In Rng
    If Cls.Row Mod 2 = 1 Then
        Cls.Interior.Color = vbGreen
    End If
 Next Cls
End Sub

akayzai1 · 12/1/14

ChanhTQ@ đã viết:

PHP:

Option Explicit
Sub DienDaySo()
Dim X As Double, Y As Double, Tmp As Double, J As Long
Dim Cls As Range, Rng As Range
 Columns("A:A").Clear
 X = Abs(Val(InputBox("nhap x = ")))
 Y = Abs(Val(InputBox("nhap y = ")))
1 ' Hoán Doi X & Y Ne1u Càn:'
 If Y <= X Then
    X = Tmp:               X = Y
    Y = Tmp
 End If
 
 For J = X + 1 To Y
    Cells(J, 1) = J
 Next J
 Set Rng = Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
 
 For Each Cls In Rng
    If Cls.Row Mod 2 = 1 Then
        Cls.Interior.Color = vbGreen
    End If
 Next Cls
End Sub

Nếu e nhập 1 số âm, 1 dương(-8,10) sao không ra kết quả đúng .Bài này em nhập 2 số bất kỳ và chỉ hiện những số ở giữa 2 số nhập vào

akayzai1 · 12/1/14

Code e viết ở trên thì khi nhập 2 số dương bất kỳ .Vd:x=9,y=12 thì ở cột A nó sẽ hiện 10,11 và sẽ tô màu cho ô chẵn là ô chứa giá trị 10

Kiều Mạnh · 12/1/14

em vẫn chưa hiểu anh chỉ .em đặt vào sự kiện trước khi tắt file excel mà . nếu như anh chỉ thì em phải thêm một modules nữa sao . mong anh chỉ dùm

akayzai1 · 12/1/14

Nhập 2 số nguyên bất kỳ bằng inputbox.Điền vào cột A giá trị nằm giữa 2 số đó.
code trên e làm thì khi nhập 2 số dương thì đúng, 1 dương 1 âm hoặc 2 âm thì sai.Bác sửa code giúp e

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

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên chậm chạm

File đính kèm

Thành viên mới

Thành viên mới

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

File đính kèm

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

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

Thành viên gắn bó

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

Thành viên gắn bó

Thành viên mới

File đính kèm

I don't program, I beat code into submission!!!

Thành viên mới

File đính kèm

Thành viên gạo cội

0901452không62

Thành viên mới

Thành viên mới

I don't program, I beat code into submission!!!

Thành viên mới

Facebook

Group