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

cuong.vp.nuce · 26/4/18

Đây là file mình làm:
Mình muốn lấy giá trị Sheet2.[B6] = Sheet1.[A3] thông qua giá trị Sheet1[C1] qua 1 nút lệnh.
Các bác có cách nào không,

batman1 · 26/4/18

truelove0310 đã viết:
code của bạn khó dùng quá. với những người không hiểu về lập trình như tôi thì càng đơn giản càng dễ dùng bạn ạ! cảm ơn bạn nhiều nhé.

Tôi viết trong chủ đề của bạn nhưng các bài viết trên GPE là cho cả những người khác, cho cả những người trong tương lai dùng công cụ tìm kiếm để có được cái họ cần. Nếu chỉ trả lời thớt thôi thì gửi vào e-mail chứ làm rác diễn đàn làm gì?
Những người khác có thể có nhiều dữ liệu hơn bạn và cách của bạn là phải đi uống cà phê. Vì tôi viết cho cả những người khác có cùng nhu cầu nên tôi viết khác và tôi lưu ý.

cuong.vp.nuce · 26/4/18

batman1 đã viết:
Tôi viết trong chủ đề của bạn nhưng các bài viết trên GPE là cho cả những người khác, cho cả những người trong tương lai dùng công cụ tìm kiếm để có được cái họ cần. Nếu chỉ trả lời thớt thôi thì gửi vào e-mail chứ làm rác diễn đàn làm gì?
Những người khác có thể có nhiều dữ liệu hơn bạn và cách của bạn là phải đi uống cà phê. Vì tôi viết cho cả những người khác có cùng nhu cầu nên tôi viết khác và tôi lưu ý.

Bạn ơi. Bạn có thể giúp mình file tesst trên kia ko bạn.

batman1 · 26/4/18

cuong.vp.nuce đã viết:
Bạn ơi. Bạn có thể giúp mình file tesst trên kia ko bạn.

Không hiểu ý lắm.
Nếu là như bạn viết thì công thức cho Sheet2!B6

Mã:

=Sheet1!A3

Trong Sheet1!C1 có công thức =B3. Dữ liệu chỉ có 1 dòng.
"B" là cố định, "3" là cố định?
Nếu không thì mô tả từ đầu, ý như thế nào.

themorzer · 1/5/18

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 hộp thoại "data is empty"
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
 colP = Sheet2.[A1].End(xlToRight).Column + 1
 rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
     
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
           
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
               
     
            Next j
       
     End If
  Next i
 ' searchdk = Arr
End Function
[code]

themorzer · 1/5/18

themorzer đã viết:

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 lần hộp thoại "data is empty" sau khi bấm OK
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
colP = Sheet2.[A1].End(xlToRight).Column + 1
rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
    
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
          
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
              
    
            Next j
      
     End If
  Next i
' searchdk = Arr
End Function
[code]

truongvu317 · 1/5/18

themorzer đã viết:

Chào Thầy!
em cần giúp đỡ, em có đoạn code dưới, nhưng khi chạy thì khi gặp giá trị rỗng trong mãng nó xuất hiện 2 hộp thoại "data is empty"
cách giải quyết như thế nào vậy thầy, mong được sự giúp đỡ

Mã:

Function searchdk(ByVal ter As String, ByVal wire As String, hsArray)
Dim colP As Long
Dim rowP As Long
colP = Sheet2.[A1].End(xlToRight).Column + 1
rowP = Sheet2.[A1].End(xlDown).Row + 1
  Dim i As Long, j As Long, dk As String, TmpArr, TmpStr, Tmp, Arr
  TmpArr = hsArray
  For i = 1 To UBound(TmpArr)
    
     If TmpArr(i, 1) = ter Then
            For j = 1 To UBound(TmpArr, 2)
                    If TmpArr(1, j) = Empty And TmpArr(1, j) <> wire Then
                        MsgBox ("data is empty")
                        Sheet2.Cells(1, colP).Value = wire
                    Exit Function
          
                    ElseIf TmpArr(1, j) = wire Then
                        searchdk = TmpArr(i, j)
                    Exit Function
                    End If
              
    
            Next j
      
     End If
  Next i
' searchdk = Arr
End Function
[code]

Tui chả hiểu bạn học vba ở đâu, chứ chả có ai viết function lại dùng mấy cái msgbox làm gì. function thì thường thì thực hiện tính toán thui, chứ không hiện thông báo làm gì. Lại còn thực hiện viết dữ liệu vào các sheet khác nữa, mặc dù nó vẫn có thể viết được dữ liệu, nhưng khi dùng trong excel thì lệnh đó sẽ vô tác dụng, thà nói mục đích là gì, người khác viết lại cho nhanh, mà chả có file thì ai dám giúp.

huongmuine · 2/5/18

Nhờ các anh chị sửa giúp ( khi bỏ đoạn code dưới ) để được kết quả như sheet KQ. Xin cảm ơn

Mã:

 N = .Range("H1").Value * 10 - 9
        STT = N - 1
    If N <= K Then
        TieuDe = .Range("I1:N1").Value
        Rws = IIf((N + 9) < K, N + 9, K)
        For I = N To Rws

Ba Tê · 2/5/18

huongmuine đã viết:
Nhờ các anh chị sửa giúp ( khi bỏ đoạn code dưới ) để được kết quả như sheet KQ. Xin cảm ơn

Mã:

N = .Range("H1").Value * 10 - 9 STT = N - 1 If N <= K Then TieuDe = .Range("I1:N1").Value Rws = IIf((N + 9) < K, N + 9, K) For I = N To Rws

Bài này quen quá!

huongmuine · 2/5/18

Ba Tê đã viết:
Bài này quen quá!

Vì đoạn code trong file được viết bởi Thầy.
Xin cảm ơn Thầy rất nhiều.

vova2209 · 2/5/18

Mã:

Sub SetupRowBangKL2()
Dim i As Long
    For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
        Sheet25.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight
    Next i
End Sub

Nhờ anh chị! vòng for này em chạy thấy chậm quá, có cách khác không ạ giúp em với. sheet dùng mảng array như nào ạ. em xin cảm ơn

HieuCD · 2/5/18

vova2209 đã viết:
Mã:

Sub SetupRowBangKL2() Dim i As Long For i = 1 To 11 Sheet24.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight Sheet25.Range("B" & i).RowHeight = Sheet23.Range("B" & i).RowHeight Next i End Sub

Nhờ anh chị! vòng for này em chạy thấy chậm quá, có cách khác không ạ giúp em với. sheet dùng mảng array như nào ạ. em xin cảm ơn

Không biết có nhanh hơn không

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
 Redim hArr(1 to 11)
    For i = 1 To 11
        hArr(i) = Sheet23.Range("B" & i).RowHeight
    Next i
  
  For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = hArr(i)
        Sheet25.Range("B" & i).RowHeight = hArr(i)
    Next i
End Sub

vova2209 · 2/5/18

HieuCD đã viết:

Không biết có nhanh hơn không

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
Redim hArr(1 to 11)
    For i = 1 To 11
        hArr(i) = Sheet23.Range("B" & i).RowHeight
    Next i

  For i = 1 To 11
        Sheet24.Range("B" & i).RowHeight = hArr(i)
        Sheet25.Range("B" & i).RowHeight = hArr(i)
    Next i
End Sub

Anh ơi! vẫn thế a à, còn cách khác ko ạ. Dòng lệnh Sheet24, Sheet25 có thể đưa vào thành 1 dòng giống như for ko ạ. Bên trên chỉ cần khai báo có những sheet ("Sheet24", "Sheet25")

HieuCD · 2/5/18

vova2209 đã viết:
Anh ơi! vẫn thế a à, còn cách khác ko ạ. Dòng lệnh Sheet24, Sheet25 có thể đưa vào thành 1 dòng giống như for ko ạ. Bên trên chỉ cần khai báo có những sheet ("Sheet24", "Sheet25")

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
  Const sArr("Sheet24","Sheet25")
  Redim hArr(1 to 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To Ubound(sArr)   
    For i = 1 To 11
        Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

vova2209 · 2/5/18

HieuCD đã viết:

Mã:

Sub SetupRowBangKL2()
Dim i As Long, hArr ()
  Const sArr("Sheet24","Sheet25")
  Redim hArr(1 to 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To Ubound(sArr)  
    For i = 1 To 11
        Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

Const sArr("Sheet24","Sheet25")
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
2 dòng này báo lỗi mầu đỏ sai cấu trúc à anh, a xem dùm hộ em

HieuCD · 2/5/18

vova2209 đã viết:
Const sArr("Sheet24","Sheet25")
Sheets(sArr(n).Range("B" & i).RowHeight = hArr(i)
2 dòng này báo lỗi mầu đỏ sai cấu trúc à anh, a xem dùm hộ em

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

vova2209 · 2/5/18

HieuCD đã viết:

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

Vẫn báo lỗi dòng này a ạ!
Const sArr = Array("Sheet24", "Sheet25")

HieuCD · 3/5/18

HieuCD đã viết:

Thiếu vài ký tự

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr()
  Const sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

Mình nhớ nhầm

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr(), sArr()
  sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

truongvu317 · 3/5/18

HieuCD đã viết:

Mình nhớ nhầm

Mã:

Sub SetupRowBangKL2()
Dim i As Long, n As Byte, hArr(), sArr()
  sArr = Array("Sheet24", "Sheet25")
  ReDim hArr(1 To 11)
  For i = 1 To 11
     hArr(i) = Sheet23.Range("B" & i).RowHeight
  Next i
  For n = 0 To UBound(sArr)
    For i = 1 To 11
        Sheets(sArr(n)).Range("B" & i).RowHeight = hArr(i)
    Next i
  Next n
End Sub

Có lẽ nó chậm là do thao tác gán chiều cao cho dòng, nếu không giải quyết được vấn đề này thì coi như hỏng.

huongmuine · 3/5/18

Mã:

If sArr(I, 19) <> Empty Then
        If Month(sArr(I, 19)) < 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) - 1 & Right(sArr(I, 19), 2)
        ElseIf Month(sArr(I, 19)) > 8 Then
            dArr(I, 8) = Right(sArr(I, 19), 2) & Right(sArr(I, 19), 2) + 1
        Else
            dArr(I, 8) = "/"
        End If
    End If

Nhờ anh chị chỉ giúp: chỉnh lại như thể nào để:
khi sArr(I, 19) = Empty thì dArr(I, 8) điền "/".

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

Huyền thoại GPE

Thành viên mới

File đính kèm

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 chính thức

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

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

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Thành viên GPE

Facebook

Group