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
Đ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 đỡ.
Đ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 đỡ.
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
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
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")
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
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
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
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
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
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
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
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
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]
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]
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
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