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

Liên hệ QC
Status
Không mở trả lời sau này.

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,930
Upvote 0
Dear anh chị GPE

Em cần trích lọc dữ liệu theo điều kiện 1, điều kiện 2, và theo thời gian từ ngày đến ngày. để làm báo cáo. Dựa vào file data

Mong anh chị giúp trợ giúp em, cho em xin cao kiến 1 đoạn code VBA để làm công việc trên ạ. File ví dụ em xin đính kèm
 

File đính kèm

  • GIUP DO.xlsx
    12.7 KB · Đọc: 6
Upvote 0
Nhờ các cao thủ GPE giúp hoàn thiện em code file này với !!!
 

File đính kèm

  • TienIch.xlsm
    29.4 KB · Đọc: 13
Upvote 0
..............................................................
 

File đính kèm

  • Quan ly khach hang (1).xls
    4.1 MB · Đọc: 6
Lần chỉnh sửa cuối:
Upvote 0
cần may anh giúp đỡ nội dung như thế này:
1. em cần cho ô A1 (là ô của lớp cụ thể bắt đầu 12A1)
2. Cho ô A1 hiển thị vào Form nhập liệu, sau khi nhập số liệu ở các dòng B2:N2 sau khi xong bấm vào LƯU DỮ LIỆU thì dòng hiện hành sẽ là ô B3:N3,.....cứ như thế đến B39:N39
link dính kèm bên dưới
 

File đính kèm

  • mau.xlsm
    18.2 KB · Đọc: 6
Upvote 0
Mã:
Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    Dim FistAddress As String
    Dim LastAddress As String
    Dim Result As Range
    Dim ws As Worksheet
    Dim firstAdd As String
 
    ' Xóa dong trong trong sheet NET
    Sheets("NET").Select
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete

 
 
    'Tim gia tri dau tien
    
    FindString = InputBox("Can Tim Kiem Cai Gi:", "Tra Cuu")
        If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("C:D")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            firstAdd = Rng.Address
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Cells(Rng.Row, 13).Value = 1
                FistAddress = Rng.Row
            Else
                MsgBox "Nothing found"
            End If
        End With
    
        'Tim gia tri cuoi cung
                With Sheets("Sheet1").Range("C:D")
            Do
        
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
            
                    'Rng = Cells(LastAddress, 3)
                    'Set Rng = .FindNext(Rng)
        
                Application.Goto Rng, True
                    Cells(Rng.Row, 13).Value = 2
                    LastAddress = Rng.Row
                    'MsgBox Cells(Rng.Row, 11)
                    'MsgBox Cells(Rng.Row, 3)
                    Set Rng = Cells(LastAddress, 3)
                    Set Rng = .FindNext(Rng)
                    FindString = Cells(LastAddress, 3)
            Else
                MsgBox "Nothing found"
            End If
            Loop While firstAdd <> Rng.Address And Cells(Rng.Row, 11) > 600
    'Copy sang Sheet NET
    Set Result = Range(Cells(FistAddress, 1), Cells(LastAddress, 12))
    Result.Select
    Selection.Copy Destination:=Sheets("NET").Range("A4")
    Sheet23.Activate
        
        End With
    
    End If

End Sub

em nhờ các anh/chị xem giúp em giờ em muốn code này tìm kiếm ở các sheet thì sửa như thế nào ạ?

topic hỏi đáp của em ở đây ạ nếu sai mod bỏ qua cho em với ạ
http://www.giaiphapexcel.com/diendan/threads/nhờ-các-bác-sửa-hoặc-tối-ưu-code-tìm-kiếm-ạ.127401/
 
Upvote 0
a (chị ) xem hộ bị lỗi vòng lặp vô hạn cách khắc phục!

Mã:
Sub sosanh()
Dim i As Integer
Dim a, b As Integer
 Sheets("1").Select
   a = Application.WorksheetFunction.RandBetween(1, 3)
   b = Application.WorksheetFunction.RandBetween(1, 3)
           Do
            Calculate
          Loop until (a = b)
        MsgBox "gia tri a va b la: " & a &" "& b
End Sub
 
Upvote 0
a (chị ) xem hộ bị lỗi vòng lặp vô hạn cách khắc phục!
Viết cái gì không hiểu luôn. Ngắt ý ở chỗ nào trong câu trên?
Dòng này "Sheets("1").Select" để làm gì?
Mã:
a = Application.WorksheetFunction.RandBetween(1, 3)
   b = Application.WorksheetFunction.RandBetween(1, 3)
           Do
            Calculate
          Loop until (a = b)
Đoạn trên chẳng có lỗi nào cả. Nó chạy vòng mãi chưa tìm thấy a=b là do mình chứ có lỗi lầm gì đâu.
Đổi thành a=RandBetween(1, 1) và b=RandBetween(1, 2) xem.
 
Upvote 0
a (chị ) xem hộ bị lỗi vòng lặp vô hạn cách khắc phục!

Mã:
Sub sosanh()
Dim i As Integer
Dim a, b As Integer
 Sheets("1").Select
   a = Application.WorksheetFunction.RandBetween(1, 3)
   b = Application.WorksheetFunction.RandBetween(1, 3)
           Do
            Calculate
          Loop until (a = b)
        MsgBox "gia tri a va b la: " & a &" "& b
End Sub
Vầy thử xem:
Mã:
Sub Test()
  Dim a As Long, b As Long
  Randomize
  Do
    a = Int(Rnd() * 3) + 1
    b = Int(Rnd() * 3) + 1
  Loop Until (a = b)
  MsgBox "gia tri a va b la: " & a & " " & b
End Sub
 
Upvote 0
a (chị ) xem hộ bị lỗi vòng lặp vô hạn cách khắc phục!

Mã:
Sub sosanh()
Dim i As Integer
Dim a, b As Integer
 Sheets("1").Select
   a = Application.WorksheetFunction.RandBetween(1, 3)
   b = Application.WorksheetFunction.RandBetween(1, 3)
           Do
            Calculate
          Loop until (a = b)
        MsgBox "gia tri a va b la: " & a &" "& b
End Sub
Mới học vba nên bị ngộ nhận. a và b trong trường hợp này chỉ được tính duy nhất một lần, Chạy cái này thì xác xuất treo máy là rất cao.
 
Upvote 0
Mã:
a = Application.WorksheetFunction.RandBetween(1, 3)
   b = Application.WorksheetFunction.RandBetween(1, 3)
           Do
            Calculate
          Loop until (a = b)
Đoạn trên chẳng có lỗi nào cả. Nó chạy vòng mãi chưa tìm thấy a=b là do mình chứ có lỗi lầm gì đâu.
Đổi thành a=RandBetween(1, 1) và b=RandBetween(1, 2) xem.

Người viết code nghĩ rằng lệnh Calculate sẽ buộc hàm WorksheetFunction.RandBetween tính lại. Và nếu tính lại thì sẽ có lúc a và b bằng nhau. Nhưng vì chúng khong tính lại nên vòng lặp vô tận.
Chỉ cần đặt con toán tính a hoặc b (hoặc cả hai) nằm trong vòng lặp là được.
 
Upvote 0
Xin mạn phép tiếp tục hỏi các thầy và các anh, ở #768 sau khi thời gian chạy về 0 rồi mới có chuông đã ok. Nhưng có một điều là vì vòng lặp của thời gian với chuông kêu là gắn liền với nhau (như code trong hình) nên xảy ra tình trạng khi chuông kêu thì thời gian chạy xuất hiện độ trễ giây (thấy rõ nhất là lúc hết giờ chuyển sang thời gian nghỉ, thời gian nghỉ lúc đó trễ giây kiểu như độ trễ giây tương đương với thời gian của file chuông kêu đó. Như ở file Bang thi dau, em cho thời gian nghỉ là 5s, thì lúc hết giờ thi đấu chuyển sang nghỉ giữa hiệp bị mất đi 1s, tức là thời gian nghỉ bắt đầu chạy lùi từ giây thứ 4 mà không phải là giây thứ 5.
1. ---> Em xin hỏi có cách nào cho thời gian chạy bình thường, không có độ trễ giây mà chuông vẫn kêu đúng như lúc: Bắt đầu thi đấu, Hết hiệp, Hết thời gian nghỉ và Kết thúc trận đấu không ạ?
2. ---> Làm sao khi thời gian nghỉ giữa hiệp chạy về đến 10s là chuông kêu thay cho chạy về đến 0s mới kêu, còn thời gian vẫn chạy lùi về 0 ạ.
Cảm ơn ạ!
 

File đính kèm

  • Bang thi dau.rar
    433.2 KB · Đọc: 13
  • Untitled.jpg
    Untitled.jpg
    210 KB · Đọc: 5
Upvote 0
Thưa thầy em có đoạn code copy: Em muốn nếu có dòng ở cột F ko có giữ liệu thì ko copy vào những dòng đó thì phải làm như nào ạ

Sub CopyPK()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim lr As Long

lr = Range("F65535").End(xlUp).row
Range("I9:AG9").Copy
Range("I10:AG" & lr).PasteSpecial Paste:=xlPasteFormulas

Range("A8").Select 'Quay con cho? lai F2

Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thưa thầy em có đoạn code copy: Em muốn nếu có dòng ở cột F ko có giữ liệu thì ko copy vào những dòng đó thì phải làm như nào ạ

Sub CopyPK()
..
End Sub
1/ Cho code vào thẻ chèn code. Tìm đọc ở mục 4 màu đỏ ở link
http://www.giaiphapexcel.com/diendan/threads/một-số-ý-kiến-về-gpe-xenforo.124418/page-2#post-778298

2/ Gợi ý:
- Cách 1: Lọc cột F với điều kiện <>"" rồi mới dán công thức vào.
- Cách 2: Làm như cách cũ, rồi lọc cột F với điều kiện =blank, rồi xóa công thức ở dòng vừa lọc được.
 
Upvote 0
Nhờ Anh/ Chị giải quyết giúp em đoạn code cho bài tập này với:
- Tại userform của Sheet2 nếu user nhập đúng tên trong cmbName thì các dữ liệu tương ứng của user đó sẽ được show trong các textbox còn lại: txtAddress, txtPhone....
- Ngược lại nếu cmbName rỗng thì sẽ được thông báo qua msgbox & sẽ tiếp tục được nhập giá trị mới vào
Em mới học vba nên phương án xử lý chưa thạo lắm.
Em xin cảm ơn ạ.
 

File đính kèm

  • homework1.xlsm
    48.9 KB · Đọc: 7
Upvote 0
Nhờ Anh/ Chị giải quyết giúp em đoạn code cho bài tập này với:
- Tại userform của Sheet2 nếu user nhập đúng tên trong cmbName thì các dữ liệu tương ứng của user đó sẽ được show trong các textbox còn lại: txtAddress, txtPhone....
- Ngược lại nếu cmbName rỗng thì sẽ được thông báo qua msgbox & sẽ tiếp tục được nhập giá trị mới vào
Em mới học vba nên phương án xử lý chưa thạo lắm.
Em xin cảm ơn ạ.
- Bạn chèn đoạn code sau vào cái nút Submit Form.
- Bạn đã thiết kế cái Combobox, sao bạn không cho chọn, mà lại thích đánh vào.

Mã:
Private Sub btnSubmit_Click()
    Dim cbName As Variant
    Dim rFind As Range
    cbName = UserForm1.cmbName.Value
    If cbName = "" Then
        MsgBox "Ban chu nhap Ten vao", vbCritical, "Chu Y"
    ElseIf cbName <> "" Then
        Set rFind = Sheets("Sheet2").Range("D2:D1000").Find(cbName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not rFind Is Nothing Then
                txtAddress = rFind.Offset(0, 1).Value
                txtPhone = rFind.Offset(0, 2).Value
                txtZipcode = rFind.Offset(0, 3).Value
            Else
                txtAddress = ""
                txtPhone = ""
                txtZipcode = ""
                MsgBox "Not Found"
            End If
    End If
End Sub
 
Upvote 0
- Bạn chèn đoạn code sau vào cái nút Submit Form.
- Bạn đã thiết kế cái Combobox, sao bạn không cho chọn, mà lại thích đánh vào.

Mã:
Private Sub btnSubmit_Click()
    Dim cbName As Variant
    Dim rFind As Range
    cbName = UserForm1.cmbName.Value
    If cbName = "" Then
        MsgBox "Ban chu nhap Ten vao", vbCritical, "Chu Y"
    ElseIf cbName <> "" Then
        Set rFind = Sheets("Sheet2").Range("D2:D1000").Find(cbName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not rFind Is Nothing Then
                txtAddress = rFind.Offset(0, 1).Value
                txtPhone = rFind.Offset(0, 2).Value
                txtZipcode = rFind.Offset(0, 3).Value
            Else
                txtAddress = ""
                txtPhone = ""
                txtZipcode = ""
                MsgBox "Not Found"
            End If
    End If
End Sub

- Hi bạn phuyen, rất cám ơn bạn đã hỗ trợ code giúp mình. Cái Combobox ở đây sẽ có tác dụng là cho chọn Name bất kỳ từ Sheet2.Range("D2:D1000"). Nếu không tìm thấy Name trong Sheet2.Range("D2:D1000") thì user có thể Add mới thông tin cần nhập vào qua nút Submit Form.
- Ở đây mình muốn áp dụng hàm Vlookup để lấy dữ liệu lên Userform1. Và cái cmbName là cái Combobox để làm tiêu chí kiểm tra dữ liệu có trong Sheet2.Range(D2:D1000) hay không.

Nhờ bạn hỗ trợ giúp code mình vấn đề này. Xin cảm ơn.
 
Upvote 0
Hi mọi người!
Mình có file excel dùng để quản lí nhân viên. Mình có tạo textbox để lọc theo họ tên, chức vụ, vị trí ... thì lọc được. nhưng lọc theo ngày tháng vào làm việc thì không được. Mong bác nào rành xem mình code lọc trong cột joint date với.
 

File đính kèm

  • list.xlsm
    25.2 KB · Đọc: 5
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom