Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Em mới xem vba mà cũng chưa biết thế nào.
Nhờ các bác cho mẫu hoặc hỗ trợ vẽ biểu đồ hình tròn dạng 3D với biên động theo file đính kèm ak.
Cảm ơn mọi người.
 

File đính kèm

  • DATA BP NHDT 1.xlsm
    30.5 KB · Đọc: 2
Upvote 0
Cho em xin hỏi:
1. Tại sao khi em ấn F8 chạy test từng lệnh, khi hết code nó chạy sang tất cả các Function mà không liên quan đến code. làm thế nào để khắc phục
 
Upvote 0
vova2209 đã viết:
Cho em xin hỏi:
1. Tại sao khi em ấn F8 chạy test từng lệnh, khi hết code nó chạy sang tất cả các Function mà không liên quan đến code. làm thế nào để khắc phục
Nhấp chuột vào đây để mở rộng...
Khả năng code của bạn có thủ tục sự kiện như worksheet_change nên khi sub đang chạy ghi dữ liệu vào sheet thì thủ tục sự kiện chạy. Nếu không muốn chạy từng lệnh của thủ tục này thì bạn bấm shift - f8 hoặc ctrl-shift-f8
 
Upvote 0
Hau151978 đã viết:
Khả năng code của bạn có thủ tục sự kiện như worksheet_change nên khi sub đang chạy ghi dữ liệu vào sheet thì thủ tục sự kiện chạy. Nếu không muốn chạy từng lệnh của thủ tục này thì bạn bấm shift - f8 hoặc ctrl-shift-f8
Nhấp chuột vào đây để mở rộng...
Đúng rồi anh à! Các sheet của em có hàm thủ tục sự kiện để tự động chạy code..
 
Upvote 0
Upvote 0
Upvote 0
Upvote 0
vova2209 đã viết:
Cho em xin hỏi:
1. Tại sao khi em ấn F8 chạy test từng lệnh, khi hết code nó chạy sang tất cả các Function mà không liên quan đến code. làm thế nào để khắc phục
Nhấp chuột vào đây để mở rộng...
Xem chỗ này có giống tình trạng của bạn không
https://www.giaiphapexcel.com/diendan/threads/không-gọi-hàm-mà-nó-vẫn-chạy.135734/
-----------------------
♫ђöล♥ßล†♥†µ♫ đã viết:
Anh @befaint đúng là chuyên gia bàn phím. Nhưng em thích kiểu ngày xưa của Anh hơn ( Tuy mất 5 nghìn đồng tiền)
Nhấp chuột vào đây để mở rộng...
Thì ra ngày xưa anh @befaint toàn chơi kiểu? Chắc kiểu hay lắm đây nên em Bất Tử thích đến bất tỉnh luôn.
Chia sẻ với anh phèn ơi
 
Upvote 0
ndu96081631 đã viết:
Xem chỗ này có giống tình trạng của bạn không
https://www.giaiphapexcel.com/diendan/threads/không-gọi-hàm-mà-nó-vẫn-chạy.135734/
-----------------------

Thì ra ngày xưa anh @befaint toàn chơi kiểu? Chắc kiểu hay lắm đây nên em Bất Tử thích đến bất tỉnh luôn.
Chia sẻ với anh phèn ơi
Nhấp chuột vào đây để mở rộng...
Dạ vâng đúng bị như trường hợp trên ạ. Có sự kiện thay đổi, e cho thêm mấy hàm tắt tính toán là okje rồi ạ. Cảm ơn anh
Bài đã được tự động gộp:

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh @befaint đúng là chuyên gia bàn phím. Nhưng em thích kiểu ngày xưa của Anh hơn ( Tuy mất 5 nghìn đồng tiền)
Nhấp chuột vào đây để mở rộng...
Anh HiếuCD đi uống Rượu về hộ em rồi.. cảm ơn anh chị nhiều
 
Upvote 0
Em mới tập tẹ viết VBA nên có mỗi đoạn này ko được nhờ các bác giup. Em có cái Macro để nhập dữ liệu, giờ em đang vướng set nếu E6 = "hq" thì không được để chống ô E16 và E17 . Code em doan duoi khi chay bao lỗi. Nhờ cả nhà giúp em với ah. Tks



Private Sub DieuxeNguyet_Click()

If Range("E6") = "hq" Then

MsgBox "Ban phai nhap ten lxe Cty"

Range("E16").SetFocus

Exit Sub

End If

If Range("E6") = "hq" Then

MsgBox "Ban chua nhap bien so lxe xe Cty se di"

Range("E17").SetFocus

Exit Sub


Else

DieuxeNguyet

End If

End Sub
 
Upvote 0
Các bác cho em hỏi chút, đoạn code bên dưới em sử dụng sao mỗi lần nhảy vào sheet nó chạy lâu, mất tầm 10"~15". Có cách nào làm nó nhanh hơn không ạ?
Mỗi lần chuyển sheet cứ phải chờ rất khó chịu ạ.
Cám ơn các bác.
Code:
Private Sub Worksheet_Activate()
Dim Rng As Range
Application.ScreenUpdating = False
For Each Rng In [A12:A35]
Rng.EntireRow.Hidden = Rng.Value = ""
Next Rng
End Sub
 
Upvote 0
denell_tran đã viết:
Các bác cho em hỏi chút, đoạn code bên dưới em sử dụng sao mỗi lần nhảy vào sheet nó chạy lâu, mất tầm 10"~15". Có cách nào làm nó nhanh hơn không ạ?
Mỗi lần chuyển sheet cứ phải chờ rất khó chịu ạ.
Cám ơn các bác.
Code:
Private Sub Worksheet_Activate()
Dim Rng As Range
Application.ScreenUpdating = False
For Each Rng In [A12:A35]
Rng.EntireRow.Hidden = Rng.Value = ""
Next Rng
End Sub
Nhấp chuột vào đây để mở rộng...
Rich (BB code): 
Private Sub Worksheet_Activate()

    Dim Rng As Range

    Application.ScreenUpdating = False

    For Each Rng In [A12:A35]

        Rng.EntireRow.Hidden = Rng.Value = ""

    Next Rng
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
denell_tran đã viết:
hỏi chút
Nhấp chuột vào đây để mở rộng...
Cho vào module:
Mã: 
Public Sub HideRow_Empty(ByVal sRng As Range)
    Dim Rng As Range, Cll As Range, oldCal
    oldCal = Application.Calculation
    Application.Calculation = xlCalculationManual
    For Each Cll In sRng 'Range("A12:A35")
        If Len(Cll.Value) = 0 Then
            If Rng Is Nothing Then
                Set Rng = Cll
            Else
                Set Rng = Union(Rng, Cll)
            End If
        End If
    Next Cll
    If Not Rng Is Nothing Then Rng.EntireRow.Hidden = True
    Application.Calculation = oldCal
End Sub
Cho vào worksheet
Mã: 
Private Sub Worksheet_Activate()
    HideRow_Empty Range("A12:A35")
End Sub
 
Upvote 0
denell_tran đã viết:
Các bác cho em hỏi chút, đoạn code bên dưới em sử dụng sao mỗi lần nhảy vào sheet nó chạy lâu, mất tầm 10"~15". Có cách nào làm nó nhanh hơn không ạ?
Mỗi lần chuyển sheet cứ phải chờ rất khó chịu ạ.
Cám ơn các bác.
Code:
Private Sub Worksheet_Activate()
Dim Rng As Range
Application.ScreenUpdating = False
For Each Rng In [A12:A35]
Rng.EntireRow.Hidden = Rng.Value = ""
Next Rng
End Sub
Nhấp chuột vào đây để mở rộng...
Code ẩn dòng theo điều kiện kiểu này nên dùng AutoFilter sẽ nhanh hơn
 
Upvote 0
Chào anh chị! nhờ anh chị xem hộ em code file này: dòng muốn dãn đánh số ở AC, AE
+ Các dòng khác chạy bình thường, chỉ riêng dòng 19 bôi đỏ như dưới hình là chạy lỗi, nhờ anh chị xem giúp em.
++ Lỗi em phát hiện
a. Đại diện đơn vị...
cho số 1 số kí tự nữa thì được
VD: 1a. Đại diện đơn vị
Nhờ anh chị xem lại code để loại bỏ lỗi đó ạ. em xin cảm ơn

Mã: 
'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub


Sub CoDanRowBB2() 'Dia chi fixrow o* bang excell
    Dim R1, R2, R3, R4, R5, R6, R7, R8 As Long
        R1 = Range("Q1"): R2 = Range("S1"): R3 = Range("U1"): R4 = Range("W1")
        R5 = Range("Y1"): R6 = Range("AA1"): R7 = Range("AC1"): R8 = Range("AE1")
       
    On Error Resume Next
    MergeCellFit Sheets("BBan").Range("E" & R1) 'Dòng fix dôc lâp.
   
    MergeCellFit Sheets("BBan").Range("T" & R7) 'Dòng fix dôc lâp.
    MergeCellFit Sheets("BBan").Range("T" & R8)
       
    Range("E" & R2).RowHeight = Range("E" & R1).RowHeight 'Chiêu` cao bàng dòng R1 (Q1)
    Range("E" & R3).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R4).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R5).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R6).RowHeight = Range("E" & R1).RowHeight
End Sub

Untitled.png
 

File đính kèm

  • BB Dan dong.xlsm
    106.5 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
vova2209 đã viết:
Chào anh chị! nhờ anh chị xem hộ em code file này: dòng muốn dãn đánh số ở AC, AE
+ Các dòng khác chạy bình thường, chỉ riêng dòng 19 bôi đỏ như dưới hình là chạy lỗi, nhờ anh chị xem giúp em.
++ Lỗi em phát hiện
a. Đại diện đơn vị...
cho số 1 số kí tự nữa thì được
VD: 1a. Đại diện đơn vị
Nhờ anh chị xem lại code để loại bỏ lỗi đó ạ. em xin cảm ơn

Mã: 
'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub


Sub CoDanRowBB2() 'Dia chi fixrow o* bang excell
    Dim R1, R2, R3, R4, R5, R6, R7, R8 As Long
        R1 = Range("Q1"): R2 = Range("S1"): R3 = Range("U1"): R4 = Range("W1")
        R5 = Range("Y1"): R6 = Range("AA1"): R7 = Range("AC1"): R8 = Range("AE1")
      
    On Error Resume Next
    MergeCellFit Sheets("BBan").Range("E" & R1) 'Dòng fix dôc lâp.
  
    MergeCellFit Sheets("BBan").Range("T" & R7) 'Dòng fix dôc lâp.
    MergeCellFit Sheets("BBan").Range("T" & R8)
      
    Range("E" & R2).RowHeight = Range("E" & R1).RowHeight 'Chiêu` cao bàng dòng R1 (Q1)
    Range("E" & R3).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R4).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R5).RowHeight = Range("E" & R1).RowHeight
    Range("E" & R6).RowHeight = Range("E" & R1).RowHeight
End Sub

View attachment 199692
Nhấp chuột vào đây để mở rộng...
Cái này do thuật toán của code không chính xác chứ không phải lỗi gì cả. Code của topic nào thì bạn vào topic đó hỏi để tác giả khắc phục.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
15
Đọc
174
VetMini
V
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
17
Đọc
388
BuiQuangThuan
B
Q
trả lời google form bằng VBA excel
Trả lời
2
Đọc
78
quoc1995db
Q
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
8
Đọc
206
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
21
Đọc
388
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom