Chuyên mục xử lý, gỡ rối code VBA (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

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,957
Chỉnh sửa dùm code nhập liệu
Mình muốn nhập 1 lần từ 5 dòng hay 8 dòng hay tất cả
bài của bạn chắc phải làm lại từ đầu (thiết kế lại cái Form) ---> ngồi sửa code theo yêu cầu trên chắc "chết" --=0

tmpForm.jpg

bạn tham khảo cách làm trong file mẫu thử nhé !
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
giúp em hoàn thiện hơn đoạn cod về mảng trên

sArr1 = Sheets("Sheet1").Range("A2:B1048576").Value

Đoạn cod trên nói là chọn mảng từ ô A2 đến ô B1048576.
Bây giờ em muốn chọn từ ô A2 đến ô cuối cùng có giá trị của Cột B thì em sửa đoạn cod trên như thế nào?
Mong sớm giúp đỡ.
 
Upvote 0
sArr1 = Sheets("Sheet1").Range("A2:B1048576").Value

Đoạn cod trên nói là chọn mảng từ ô A2 đến ô B1048576.
Bây giờ em muốn chọn từ ô A2 đến ô cuối cùng có giá trị của Cột B thì em sửa đoạn cod trên như thế nào?
Mong sớm giúp đỡ.
Theo kiểu liều 1 chút
PHP:
With Sheets("Sheet1")
            sArr1 = .Range(.[A2], .[B1048576].End(3)).Value
End With
 
Upvote 0
Rút gọn code tách chuỗi

Mình có viết một code tách chuỗi là một dãy số kết quả ra đúng như mong muốn. nhưng nhìn vào code thấy nó dài dòng hoa cả mắt... Mình úp lên đây nhờ các bạn xem có cách nào khác viết xúc tích ngắn gọn và dễ hiểu hơn không chỉ dùm cho mình học với
xin cảm ơn
PHP:
Sub Tach_Chuoi()
Dim nguon(), R(1 To 65536, 1 To 1), L(1 To 65536, 1 To 1), i As Long
With Sheet1
    nguon = .Range(.[D4], .[D65536].End(3)).Value
End With
For i = 1 To UBound(nguon, 1)
    R(i, 1) = nguon(i, 1)
    L(i, 1) = nguon(i, 1)
        R(i, 1) = Replace(Replace(R(i, 1), " ", ""), ".", "")
        L(i, 1) = Replace(Replace(R(i, 1), " ", ""), ".", "")
    R(i, 1) = Left(R(i, 1), 4)
    L(i, 1) = Right(L(i, 1), 6)
Next i
With Sheet1
    .Range("E4:F15000").ClearContents
    .Range("E4").Resize(i) = R
    .Range("F4").Resize(i) = L
End With
End Sub
 

File đính kèm

Upvote 0
Mình có viết một code tách chuỗi là một dãy số kết quả ra đúng như mong muốn. nhưng nhìn vào code thấy nó dài dòng hoa cả mắt... Mình úp lên đây nhờ các bạn xem có cách nào khác viết xúc tích ngắn gọn và dễ hiểu hơn không chỉ dùm cho mình học với
xin cảm ơn
PHP:
Sub Tach_Chuoi()
Dim nguon(), R(1 To 65536, 1 To 1), L(1 To 65536, 1 To 1), i As Long
With Sheet1
    nguon = .Range(.[D4], .[D65536].End(3)).Value
End With
For i = 1 To UBound(nguon, 1)
    R(i, 1) = nguon(i, 1)
    L(i, 1) = nguon(i, 1)
        R(i, 1) = Replace(Replace(R(i, 1), " ", ""), ".", "")
        L(i, 1) = Replace(Replace(R(i, 1), " ", ""), ".", "")
    R(i, 1) = Left(R(i, 1), 4)
    L(i, 1) = Right(L(i, 1), 6)
Next i
With Sheet1
    .Range("E4:F15000").ClearContents
    .Range("E4").Resize(i) = R
    .Range("F4").Resize(i) = L
End With
End Sub
Hên xui nha
PHP:
Sub Tach_Chuoi()
Dim nguon(), i As Long
With Sheet1
   nguon = .Range(.[D4], .[D65536].End(3)).Value
   ReDim Preserve nguon(1 To UBound(nguon), 1 To 3)
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      For i = 1 To UBound(nguon, 1)
         nguon(i, 2) = Left(.Replace(nguon(i, 1), ""), 4)
         nguon(i, 3) = Right(.Replace(nguon(i, 1), ""), 6)
      Next i
   End With
   .Range("E4:F65536").ClearContents
   .Range("D4:F4").Resize(i - 1) = nguon
End With
End Sub
Hoặc là
PHP:
Sub Tach_Chuoi()
Dim nguon(), i As Long
With Sheet1
   .Range("E4:F65536").ClearContents
   nguon = .Range(.[D4], .[D65536].End(3)).Resize(, 3).Value
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      For i = 1 To UBound(nguon, 1)
         nguon(i, 2) = Left(.Replace(nguon(i, 1), ""), 4)
         nguon(i, 3) = Right(.Replace(nguon(i, 1), ""), 6)
      Next i
   End With
   .Range("D4:F4").Resize(i - 1) = nguon
End With
End Sub
Muốn gọn hơn thì dùng hàm
PHP:
Function TachChuoi(ByVal cell As String, dk As String) As String
   Dim tam As String
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      tam = .Replace(cell, "")
      TachChuoi = IIf(dk = "L", Left(tam, 4), Right(tam, 6))
   End With
End Function
Cú pháp =tachchuoi(D4,"L") hoặc =tachchuoi(D4,"R")
 
Lần chỉnh sửa cuối:
Upvote 0
Hên xui nha
PHP:
Sub Tach_Chuoi()
Dim nguon(), i As Long
With Sheet1
   nguon = .Range(.[D4], .[D65536].End(3)).Value
   ReDim Preserve nguon(1 To UBound(nguon), 1 To 3)
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      For i = 1 To UBound(nguon, 1)
         nguon(i, 2) = Left(.Replace(nguon(i, 1), ""), 4)
         nguon(i, 3) = Right(.Replace(nguon(i, 1), ""), 6)
      Next i
   End With
   .Range("E4:F65536").ClearContents
   .Range("D4:F4").Resize(i - 1) = nguon
End With
End Sub
Hoặc là
PHP:
Sub Tach_Chuoi()
Dim nguon(), i As Long
With Sheet1
   .Range("E4:F65536").ClearContents
   nguon = .Range(.[D4], .[D65536].End(3)).Resize(, 3).Value
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      For i = 1 To UBound(nguon, 1)
         nguon(i, 2) = Left(.Replace(nguon(i, 1), ""), 4)
         nguon(i, 3) = Right(.Replace(nguon(i, 1), ""), 6)
      Next i
   End With
   .Range("D4:F4").Resize(i - 1) = nguon
End With
End Sub
Muốn gọn hơn thì dùng hàm
PHP:
Function TachChuoi(ByVal cell As String, dk As String) As String
   Dim tam As String
   With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "\D"
      tam = .Replace(cell, "")
      TachChuoi = IIf(dk = "L", Left(tam, 4), Right(tam, 6))
   End With
End Function
Cú pháp =tachchuoi(D4,"L") hoặc =tachchuoi(D4,"R")
hàm thì em có hai hàm này rồi. em úp lên chủ yếu tham khảo nhiều cách viết để học thôi.
PHP:
Function LAY6SO(Cll As Range)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\D"
    LAY6SO = Right(.Replace(Cll, ""), 6)
End With
End Function
PHP:
Function LAY4SO(Cll As Range)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\D"
    LAY4SO = Left(.Replace(Cll, ""), 4)
End With
End Function
vậy là cùng một vấn đề ta có nhiều cách giải quyết khác nhau..
hôm nay em thật sự hiểu thêm một cách viết nữa đó là sử dung "ReDim Preserve nguon(1 To UBound(nguon), 1 To 3) "
Thanks Anh nhiều... Học được rất nhiều từ bài viết của Anh
 
Upvote 0
Sửa lỗi hàm Function trong VBA

Các anh chị ơi, em đang mày mò học VBA và có viết 1 hàm này mà sao trong Excel nó không chạy, không biết nó có lỗi gì không nữa, mong các anh chị giúp em với.

Option Explicit
Function ctc() As Double
Dim a As Double
Dim b As Double
ctc = a + b
End Function

Em xin cám ơn lắm lắm.
 
Upvote 0
Các anh chị ơi, em đang mày mò học VBA và có viết 1 hàm này mà sao trong Excel nó không chạy, không biết nó có lỗi gì không nữa, mong các anh chị giúp em với.

Option Explicit
Function ctc() As Double
Dim a As Double
Dim b As Double
ctc = a + b
End Function

Em xin cám ơn lắm lắm.

Bạn nói hàm không chạy là không đúng! Nó vẫn chạy, có điều kết quả luôn =0. Cũng đúng thôi! Có truyền tham số gì cho a và b đâu mà tính toán được
 
Upvote 0
Các anh chị ơi, em đang mày mò học VBA và có viết 1 hàm này mà sao trong Excel nó không chạy, không biết nó có lỗi gì không nữa, mong các anh chị giúp em với.

Option Explicit
Function ctc() As Double
Dim a As Double
Dim b As Double
ctc = a + b
End Function

Em xin cám ơn lắm lắm.
Chuyển khai báo a, b vào trong () của hàm là được
 
Upvote 0
Các anh chị ơi, em đang mày mò học VBA và có viết 1 hàm này mà sao trong Excel nó không chạy, không biết nó có lỗi gì không nữa, mong các anh chị giúp em với.

Option Explicit
Function ctc() As Double
Dim a As Double
Dim b As Double
ctc = a + b
End Function

Em xin cám ơn lắm lắm.
Viết kỳ quá sao chạy được trời. Có tệ lắm cũng phải vầy
PHP:
Function ctc(a, b)
ctc = a + b
End Function
Sub main()
MsgBox ctc(5, 10)
End Sub
 
Upvote 0
Các anh chị ơi, em đang mày mò học VBA và có viết 1 hàm này mà sao trong Excel nó không chạy, không biết nó có lỗi gì không nữa, mong các anh chị giúp em với.

Option Explicit
Function ctc() As Double
Dim a As Double
Dim b As Double
ctc = a + b
End Function

Em xin cám ơn lắm lắm.

Hàm của bạn hoàn toàn hợp lệ. Chỉ có điều vô dụng thôi. Và do bạn không gán giá trị cho a , b nên chúng có giá trị = 0, do vậy hàm của bạn luôn trả về kết quả 0
----------
Function luôn trả về giá trị còn Sub không trả về giá trị. Đó là đặc trưng, là đòi hỏi cần có duy nhất. Còn mọi chuyên khác là tuỳ ý. Tức Sub có thể làm một loạt chuyện có ích và vô ích (không cấm), còn Function có thể làm một loạt chuyện có ích và vô ích (không cấm) và trả về giá trị nào đó.
Mã:
Sub hichic()
    một loạt chuyện có ích và vô ích
End Sub

Function bla() as ABC
    một loạt chuyện có ích và vô ích
...
    bla = xyz    <-- A
End Function

Tất nhiên ở trên hàm trả về giá trị một cách ... tường minh (???). Nếu không có <-- A thì hàm trả về giá trị 0, "", Empty ... tùy theo typ ABC.

Đó là "đòi hỏi" tối thiểu. Tham số không bắt buôc. Nhưng tham số được phép.

Việc chuyển a, b thành tham số chưa hẳn là thế. Tùy vào cái bạn định làm. Do bạn không nói a, b lấy từ đâu nên tôi xét 2 phương án.

1. a, b là tỷ giá trong ngày hiện hành của ngân hàng A và B. Và bạn muốn tính tỷ giá trung bình. Thế thì chả tham số gì cả
Mã:
Function bla() As Double
Dim a as Double, b As Double
... kết nối với trang của A và tải tỷ giá a = abc
... kết nối với trang của B và tải tỷ giá b = xyz
... kết nối với trang C và đọc nhiệt độ trong ngày, làm để giết thời gian hoặc 
để ghi ra "Sổ theo dõi"
    bla = (a + b) / 2
End Function

Nếu có "kết nối với trang C" thì là "1 công đôi việc". Tuy không có tham số nào cả nhưng rõ ràng mỗi lần gọi hàm thì nó có thể trả về những giá trị khác nhau do tỷ giá thay đổi.

2. a, b là số điểm nào đó tích lũy được của học sinh (hs) cụ thể trong học kỳ I và II. Và bạn muốn tính tổng số điểm cả năm. Thế thì phải truyền tham số a, b để tính cho từng hs cụ thể.
Mã:
Function bla(ByVal a As Double, ByVal b As Double) As Double
... kết nối với trang C và đọc nhiệt độ trong ngày, làm để giết thời gian hoặc 
để ghi ra "Sổ theo dõi"
    bla = a + b
End Function

Nếu có "kết nối với trang C" thì là "1 công đôi việc"

Về ByVal hay ByRef thì bạn tự đọc. Tôi chỉ muốn tiết lộ một điểm. Có những lúc "bắt buộc" phải là ByRef. Vd. mảng (tham số truyền với tư cách "mảng", tức Arr() As Long hoặc Arr(). Nếu chỉ là Arr thì Arr đơn giản chỉ là 1 Variant. Nhưng khi gọi hàm thì có thể truyền mảng vào chỗ Arr) luôn được truyền ByRef. Kiểu dữ liệu người dùng (UDT) luôn được truyền ByRef.

Function / Sub không bắt buộc phải làm 1 việc mà có thể làm 1000 việc, thậm chí 1000 việc đều thuộc loại "vô ích". Không có cấm đoán gì ở đây. Thậm chí Function / Sub không phải làm cái gì cả.
Code
Mã:
Sub hichic()

End Sub

Function bla(ByVal a As String) As String
   
End Function

Sub test()
Dim s As String
    s = "hic hic"
    hichic
    MsgBox bla(s)
End Sub

là hoàn toàn hợp lệ, và hichic cũng như bla có đầy đủ tư cách như những sub / function khác để đeo huy hiệu sub / function.

Việc viết code như thế nào, tính toán gì hay không tính toán gì là tùy vào bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình xin cảm ơn tất cả các comment có thiện chí. đã bấm thanks.
 
Upvote 0
Nhờ Chỉnh Sửa, Bổ Sung Thêm Code

Mình có viết hai code khi copy dữ liệu sang bên nối đuôi nhau liên tiếp xuống xong thì loc duy nhất luôn...hiện chạy rất tốt kết quả ra đúng như mong muốn....
Nhưng phát sinh một điều mà mình chưa làm được khi mình cập nhật giá ở bên nguồn thì giá bên kết quả cũng cập nhật theo khi chạy code....cứ loanh quanh vậy hoài mà chưa nghĩ ra được Mong các Bạn trợ giúp
#Có bao giờ mình có 5 con Bò ngồi trên lưng một con... quay lại đếm tới kiểm lui mà vẫn chỉ có 4 con thôi không >>>???
PHP:
Sub Luu_Ban() 'Copy nhung so da ban luu ghi nho
Dim Nguon(), kq(1 To 65536, 1 To 4), i As Long, j As Long
With Sheet1
   Nguon = .Range("D4", .[D65536].End(3)).Resize(, 4).Value
For i = 1 To UBound(Nguon, 1)
    For j = 1 To 4
        kq(i, 1) = Nguon(i, 1)
        kq(i, j) = Nguon(i, 4)
    Next j
Next i
.[L65536].End(3)(2).Resize(i - 1, 2) = kq
.[N65536].End(3)(2).Resize(i - 1, 1) = Format(Now, "dd/mmm/yyyy")
End With
   Call Loc_DN_Luu
End Sub

Sub Loc_DN_Luu() 'Loc duy nhat nhung so da luu
Dim Nguon(), kq(1 To 65536, 1 To 3), i As Long, k As Long
With Sheet1
    Nguon = .Range(.[L4], .[N65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Nguon)
        If Not .exists(Nguon(i, 1)) Then
            k = k + 1
            .Add Nguon(i, 1), ""
            kq(k, 1) = Nguon(i, 1)
            kq(k, 2) = Nguon(i, 2)
            kq(k, 3) = Nguon(i, 3)
        End If
    Next
End With
    .Range("L4:N65536").ClearContents
    .Range("L4").Resize(k, 3) = kq
End With
End Sub
 

File đính kèm

Upvote 0
Mình có viết hai code khi copy dữ liệu sang bên nối đuôi nhau liên tiếp xuống xong thì loc duy nhất luôn...hiện chạy rất tốt kết quả ra đúng như mong muốn....
Nhưng phát sinh một điều mà mình chưa làm được khi mình cập nhật giá ở bên nguồn thì giá bên kết quả cũng cập nhật theo khi chạy code....cứ loanh quanh vậy hoài mà chưa nghĩ ra được Mong các Bạn trợ giúp
#Có bao giờ mình có 5 con Bò ngồi trên lưng một con... quay lại đếm tới kiểm lui mà vẫn chỉ có 4 con thôi không >>>???
Tách ra 2 sự kiện:
1/ KHi cập nhật giá từng mặt hàng bằng cái này:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ma As String, Rng As Range, Cll As Range
Set Rng = Range([L4], [L4].End(xlDown))
If Not Intersect(Target, [G4:G1000]) Is Nothing Then
If Target.Rows.Count = 1 Then
Ma = Target.Offset(, -3).Value
For Each Cll In Rng
If Cll.Value = Ma Then
Cll.Offset(, 1).Value = Target.Value
Cll.Offset(, 2) = Date
Exit For
End If
Next Cll
End If
End If
Set Rng = Nothing
End Sub[/GPECODE]
Khi muốn chép nối thêm vào và lọc duy nhất theo mã hàng thì cho chạy Sub này:
[GPECODE=vb]Public Sub Ghep()
Dim Dic As Object, sArr1(), sArr2(), dArr(), I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr2 = Range([L4], [L4].End(xlDown)).Resize(, 3).Value
sArr1 = Range([D4], [D4].End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr1, 1) + UBound(sArr2, 1), 1 To 3)
For I = 1 To UBound(sArr2, 1)
Tem = sArr2(I, 1)
If Not Dic.exists(Tem) Then
K = K + 1
Dic.Add Tem, Empty
For J = 1 To 3
dArr(K, J) = sArr2(I, J)
Next J
End If
Next I
For I = 1 To UBound(sArr1, 1)
Tem = sArr1(I, 1)
If Not Dic.exists(Tem) Then
K = K + 1
dArr(K, 1) = sArr1(I, 1)
dArr(K, 2) = sArr1(I, 4)
dArr(K, 3) = Date
End If
Next I
[L4].Resize(K, 3) = dArr
End Sub[/GPECODE]
 
Upvote 0
Tách ra 2 sự kiện:
1/ KHi cập nhật giá từng mặt hàng bằng cái này:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ma As String, Rng As Range, Cll As Range
Set Rng = Range([L4], [L4].End(xlDown))
If Not Intersect(Target, [G4:G1000]) Is Nothing Then
If Target.Rows.Count = 1 Then
Ma = Target.Offset(, -3).Value
For Each Cll In Rng
If Cll.Value = Ma Then
Cll.Offset(, 1).Value = Target.Value
Cll.Offset(, 2) = Date
Exit For
End If
Next Cll
End If
End If
Set Rng = Nothing
End Sub[/GPECODE]
Khi muốn chép nối thêm vào và lọc duy nhất theo mã hàng thì cho chạy Sub này:
[GPECODE=vb]Public Sub Ghep()
Dim Dic As Object, sArr1(), sArr2(), dArr(), I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr2 = Range([L4], [L4].End(xlDown)).Resize(, 3).Value
sArr1 = Range([D4], [D4].End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr1, 1) + UBound(sArr2, 1), 1 To 3)
For I = 1 To UBound(sArr2, 1)
Tem = sArr2(I, 1)
If Not Dic.exists(Tem) Then
K = K + 1
Dic.Add Tem, Empty
For J = 1 To 3
dArr(K, J) = sArr2(I, J)
Next J
End If
Next I
For I = 1 To UBound(sArr1, 1)
Tem = sArr1(I, 1)
If Not Dic.exists(Tem) Then
K = K + 1
dArr(K, 1) = sArr1(I, 1)
dArr(K, 2) = sArr1(I, 4)
dArr(K, 3) = Date
End If
Next I
[L4].Resize(K, 3) = dArr
End Sub[/GPECODE]
Chính xác tuyệt đối Anh Ba Tê
Thanks Anh Nhiều
 
Upvote 0
Giải thích mã vba

Function congdon() As Long
Static s
s
= s + Range("A1").Value
congdon
= s
End
Function
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If
Not Intersect(Target, [A1]) Is Nothing Then
Range
("B1").Value = congdon
End
If
End Sub
mọi người cho em hỏi.em muốn sử dụng cộng dồn A1 thi kết quả với B1 rồi.còn em muốn với nhiều ô khác như,A2 với B2,và A3 với B3 và tiếp tục nữa thì làm sao
em xin cảm ơn
 
Upvote 0
có ai biết không giúp em với

không biết là tiêu đề của bạn như vậy có được coi là rỏ ràng không. nếu ko rỏ ràng thì có thể bị khóa

bạn có thể giải thích thêm cộng dồn là sao không?
thí dụ tôi gõ
A1=5==>B1=5
tiếp tục gõ
A1=5==>B1=10?
vậy phải không?
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1:A10]) Is Nothing Then Target.Offset(, 1) = Target + Target.Offset(, 1)

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

Back
Top Bottom