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

akevin · 9/7/14

đã xong rồi các bác ak

Quang_Hải · 9/7/14

akevin đã viết:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Dangchon As Range
 [U]   [B]Dangchon = ActiveCell[/B][/U]
    Select Case ActiveCell.Row
        Case Is < 21
            Range("2:2").EntireRow.Select
            ActiveWindow.FreezePanes = True
            Dangchon.Select
        Case Is < 41
            Range("22:22").EntireRow.Select
            ActiveWindow.FreezePanes = True
            Dangchon.Select
        Case Is < 61
            Range("42:42").EntireRow.Select
            ActiveWindow.FreezePanes = True
            Dangchon.Select
        Case Else
            Range("62:62").EntireRow.Select
            ActiveWindow.FreezePanes = True
            Dangchon.Select
    End Select
End Sub

Xin code cho phần này ak, mình muốn frezze panel khi chọn cái vùng kia, cảm ơn các bạn

Tạm sửa thế này

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveWindow.FreezePanes = False
    Dim Dangchon As Range
    Set Dangchon = ActiveCell
    Select Case ActiveCell.Row
        Case Is < 21
            Range("2:2").EntireRow.Select
            ActiveWindow.FreezePanes = True
        Case Is < 41
            Range("22:22").EntireRow.Select
            ActiveWindow.FreezePanes = True
        Case Is < 61
            Range("42:42").EntireRow.Select
            ActiveWindow.FreezePanes = True
            Dangchon.Select
        Case Else
            Range("62:62").EntireRow.Select
            ActiveWindow.FreezePanes = True
    End Select
Application.EnableEvents = True
End Sub

vutienloc99 · 11/7/14

Chào các Bác.

code VBA sau:

Mã:

Option Explicit


Public Sub ChamCong()
On Error Resume Next
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Tem As Long, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DATA")
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 5).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 33)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    Col = Right(sArr(I, 3), 2) * 2 + 2
    If Val(Left(sArr(I, 4), 2)) > 12 Then Col = Col + 1
    [U]If Not Dic.Exists(Tem) Then[/U]
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = K
        dArr(K, 2) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 2)
    End If
    dArr(Dic.Item(Tem), Col) = sArr(I, 4)
Next I
Application.ScreenUpdating = False
With Sheets("ChamCong")
    .[A5:A1000].Resize(, 33).ClearContents
    .[A5:A1000].Resize(, 33).Borders.LineStyle = xlNone
    If K Then
        .[A5].Resize(K, 33) = dArr
        .[A5].Resize(K, 33).Borders.LineStyle = xlContinuous
    End If
End With
Application.ScreenUpdating = True
Set Dic = Nothing
End Sub

E muốn nhờ các Bác giải thích dòng code e gạch chân có nghĩa gì?

Thanks.

Quang_Hải · 11/7/14

vutienloc99 đã viết:
Chào các Bác.

code VBA sau:

Mã:

Option Explicit E muốn nhờ các Bác giải thích dòng code e gạch chân có nghĩa gì? Thanks.[/QUOTE] Có giải thích bạn cũng thấy lờ mờ thôi vì nó liên quan nhiều thứ lắm. Tạm dịch là: Nếu chưa có trong Dic thì....

akevin · 11/7/14

Function TimSLOB(O As String)
Dim i As Range
With Sheet2.Range("A1:A589")
Set i = .Find(O, LookIn:=xlValues, LookAt:=xlWhole)
TimOB = Range("G" & i.Row - 1).Value
End With
End Function

Các bác xem cho mình vì sao cái function này không hoạt động được không?

ndu96081631 · 11/7/14

akevin đã viết:
Các bác xem cho mình vì sao cái function này không hoạt động được không? :

Function TimSLOB(O As String)
Dim i As Range
With Sheet2.Range("A1:A589")
Set i = .Find(O, LookIn:=xlValues, LookAt:=xlWhole)
TimOB = Range("G" & i.Row - 1).Value
End With
End Function

Nhấp chuột vào đây để mở rộng...

Phương thức Find sẽ không hoạt động với Function đâu, khỏi suy nghĩ
Bạn áp dụng Function ấy trực tiếp trong VBA còn có thể chứ nếu bạn gõ function ấy trên bảng tính thì da phần sẽ.. lỗi

akevin · 11/7/14

ndu96081631 đã viết:
Phương thức Find sẽ không hoạt động với Function đâu, khỏi suy nghĩ
Bạn áp dụng Function ấy trực tiếp trong VBA còn có thể chứ nếu bạn gõ function ấy trên bảng tính thì da phần sẽ.. lỗi

Vậy khi em muốn tìm ở trong bảng tính một ô rồi muốn lấy giá trị của các ô gần đó thì mình phải như thế nào với Function ạ, cảm ơn bác

ndu96081631 · 11/7/14

akevin đã viết:
Vậy khi em muốn tìm ở trong bảng tính một ô rồi muốn lấy giá trị của các ô gần đó thì mình phải như thế nào với Function ạ, cảm ơn bác

Dùng For... Next duyệt qua vùng cần tìm ---> Vậy thôi

akevin · 14/7/14

Em đã giải quyết được

akevin · 22/7/14

Mã:

Sub Capnhat()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim Cell As Range
    Dim Cll As Range
    For Each Cell In Sheet5.Range("D2:D" & [d50000].End(xlUp).Row)
        If Left(Cell, 2) = "PX" Then
            If Cell.Offset(0, -3).Value <> "x" Then
            For Each Cll In Sheets(Cell.Offset(0, 16).Value).Range("c7:c" & [c50000].End(xlUp).Row)
                If Cell.Offset(0, 6).Value = Cll.Value Is Nothing Then
                    Sheets(Cell.Offset(0, 16).Value).[c50000].End(xlUp).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
                    Sheets(Cell.Offset(0, 16).Value).[c7].End(xlDown).Offset(1, 0).Value = Cell.Offset(, 6)
                    Sheets(Cell.Offset(0, 16).Value).[c7].End(xlDown).Offset(1, 1).Value = Cell.Offset(, 7)
                    Sheets(Cell.Offset(0, 16).Value).Range("C" & [c7].End(xlDown)(1, 0).Row & ":F" & [c7].End(xlDown)(1, 0).Row).Value = Sheet5.Range(Cell.Offset(, 6), Cell.Offset(, 9))
                    Cell.Offset(0, -3).Value = "x"
                End If
            Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Các bác giải thích vì sao đoạn code này của em không hoạt động không ak? Excel treo luôn ak

Em cảm ơn các bác ạ

phucbugis · 22/7/14

akevin đã viết:
Mã:

Sub Capnhat() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ....... Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

Các bác giải thích vì sao đoạn code này của em không hoạt động không ak? Excel treo luôn ak
Em cảm ơn các bác ạ

bạn nên đính kèm thêm File để mọi người có thể kiểm tra giúp... !

ptm0412 · 22/7/14

Không phải Excel treo, mà là nó chạy chưa xong. Vừa tính toán nhiều, vừa lặp nhiều, vừa phải chạy lên chạy xuống sheet.

Một vài ý khác:

PHP:

For Each Cell In Sheet5.Range("D2:D" & [d50000].End(xlUp).Row)
...
    For Each Cll In Sheets(Cell.Offset(0, 16).Value).Range("c7:c" & [c50000].End(xlUp).Row)
...
    Sheets(Cell.Offset(0, 16).Value).Range("C" & [c7].End(xlDown)(1, 0).Row &

Công việc tính row phải tính rất nhiều lần

Mã:

If Cell.Offset(0, 6).Value = Cll.Value [COLOR="#FF0000"]Is Nothing[/COLOR] Then

Sao lại có cái đỏ đỏ?

akevin · 23/7/14

ptm0412 đã viết:
Không phải Excel treo, mà là nó chạy chưa xong. Vừa tính toán nhiều, vừa lặp nhiều, vừa phải chạy lên chạy xuống sheet.

Một vài ý khác:

PHP:

For Each Cell In Sheet5.Range("D2:D" & [d50000].End(xlUp).Row) ... For Each Cll In Sheets(Cell.Offset(0, 16).Value).Range("c7:c" & [c50000].End(xlUp).Row) ... Sheets(Cell.Offset(0, 16).Value).Range("C" & [c7].End(xlDown)(1, 0).Row &

Công việc tính row phải tính rất nhiều lần

Mã:

If Cell.Offset(0, 6).Value = Cll.Value [COLOR=#FF0000]Is Nothing[/COLOR] Then

Sao lại có cái đỏ đỏ?

Cái đỏ đỏ là nếu cái ở bên sheet bên này bằng với giá trị bên kia thì sẽ không làm gì cả, còn nếu không thì sẽ thêm 1 dòng và copy mọt số dữ liệu bên sheet kia sang đó bác

Em đính kèm file lên cho mọi người dễ hình dung ak

HTML:

https://www.dropbox.com/s/fk93qhhy20y3zok/B%C3%A1o%20c%C3%A1o%20stock%20nh%C3%A0%20m%C3%A1y%207.2014%20-%20Copy.xlsm

phucbugis · 23/7/14

akevin đã viết:
Cái đỏ đỏ là nếu cái ở bên sheet bên này bằng với giá trị bên kia thì sẽ không làm gì cả, còn nếu không thì sẽ thêm 1 dòng và copy mọt số dữ liệu bên sheet kia sang đó bác
Em đính kèm file lên cho mọi người dễ hình dung ak

HTML:

https://www.dropbox.com/s/fk93qhhy20y3zok/B%C3%A1o%20c%C3%A1o%20stock%20nh%C3%A0%20m%C3%A1y%207.2014%20-%20Copy.xlsm

code của bạn muốn cải thiện tốc độ thì có thể phải dùng mảng hoặc phương thức Find hoặc Union khi chèn Row ... ^^^^

akevin · 23/7/14

phucbugis đã viết:
code của bạn muốn cải thiện tốc độ thì có thể phải dùng mảng hoặc phương thức Find hoặc Union khi chèn Row ...

bác nối thêm chi tiết cho em về vấn đề này được không

levanhoatdp · 23/7/14

em có file excel bị lỗi nó báo như sau:
file excel cannot accessed the file may be corrupted, located on a server that is not responding, or read-only
em đang dùng excel 2010 có anh chị nào biết cách khắc phục giúp em với ạ... Hu hu

Cá ngừ F1 · 23/7/14

levanhoatdp đã viết:
em có file excel bị lỗi nó báo như sau:
file excel cannot accessed the file may be corrupted, located on a server that is not responding, or read-only
em đang dùng excel 2010 có anh chị nào biết cách khắc phục giúp em với ạ... Hu hu

Không có file thì khó cho các thành viên bắt bệnh bạn ạh

phucbugis · 23/7/14

akevin đã viết:
bác nối thêm chi tiết cho em về vấn đề này được không

- mới thử phương thức Find thay thế cho 1 vòng lặp mà đã thấy ... ^^^^

- mình mới chạy thử với 1 sheet EXT, bạn xem có đúng kết quả ko rồi tính tiếp ... !

Mã:

Sub Capnhat()
Dim CurSheet As Worksheet, ws As Worksheet
Dim Cell As Range
Dim iRow1 As Long, iRow2 As Long
Dim Rng As Range, rngFound As Range

'chua cai` Unhide Row cho cac sheet.

    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
    Set CurSheet = Sheets("update")
    For Each Cell In CurSheet.Range("D2:D" & Range("D65000").End(xlUp).Row)
    If CurSheet.Range("T" & Cell.Row) = "EXT" Then
        If Left(Cell, 2) = "PX" And Cell.Offset(0, -3) <> "x" Then
        iRow1 = Cell.Row
        On Error Resume Next 'neu ko co' Ten sheet
            Set ws = Sheets(CurSheet.Range("T" & iRow1).Value)
            Set Rng = ws.Range("C7:C65000")
            Set rngFound = Rng.Find(CurSheet.Range("J" & iRow1).Value, , xlValues, xlWhole) 'xlWhole--> tim` chinh' xac
            '---------
            If rngFound Is Nothing Then 'neu ko tim` thay'
                iRow2 = ws.Range("C65000").End(xlUp).Offset(1, 0).Row
                ws.Range("C" & iRow2).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
                ws.Range("C" & iRow2).Resize(, 4).Value = CurSheet.Range("J" & iRow1).Resize(, 4).Value
                Cell.Offset(0, -3) = "x"
            End If
        End If
    End If
    Next
    
    'Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "xong"
End Sub

VetMini · 23/7/14

levanhoatdp đã viết:
em có file excel bị lỗi nó báo như sau:
file excel cannot accessed the file may be corrupted {1}, located on a server that is not responding {2}, or read-only {3}
em đang dùng excel 2010 có anh chị nào biết cách khắc phục giúp em với ạ... Hu hu {4}

{1} File bị hư. Phải có file mới biết được.

{2} Không đi qua mang (nội bộ?) được. Đường comm bị ket?

{3} Vào properties của file mà check. Cái này hay xảy ra ở file gỏi qua Outlook.

{4} Rên la giữa chợ mà không biết mắc cở à?

=== Bổ sung ===

Vấn đề này có liên quan gì đến VBA? Bạn hỏi ở đây là trật chỗ. Có nhiều người rất giỏi về hệ thống, có thể giải quyết cho bạn dễ dàng nhưng vì bạn đặt ở thớt này cho nên họ không thấy. Người giỏi về hệ thống chưa chắc đã thích viết code, và họ không buồn xem các đề tài có liên quan đến VBA.

VetMini · 23/7/14

Lỗi này thường xảy ra khi Khi một máy hệ Win7 với Excel 2010 mở file xls được đã ghi trong Excel 2003 ở hệ điều hành XP.
Trường hợp này là do Win7 muốn ghi lại một phiên bản offline của file.

Nếu đúng lỗi thì cách khắc phục dễ nhất là đặt Offline files OFF.

Lỗi cũng có thể xảy ra khi đọc file trên thẻ USB, và thẻ này bị đặt điều kiện gì đó. Khắc phục: copy ra đĩa cứng.

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

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

Thành viên mới

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

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

File đính kèm

Thành viên mới

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

Bad Excel Member

Thành viên mới

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

Thành viên mới

Thành viên mới

( ͡° ͜ʖ ͡°)

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

File đính kèm

Ăn cùng góc phố

Ăn cùng góc phố

Đếm ngược thời gian