đúng rồi bác ơi, bác làm cho em để nó cập nhật cho tất cả các sheet với, em cảm ơn nhiều lắm- 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
Sub a()
Dim i As Integer
Dim n As Integer
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
n = Range("a2").End(xlDown).Row
For i = 2 To n
[COLOR=#b22222]If Not dic.Exists(Cells(i, 1).Text) Then
dic.Add Cells(i, 1).Text, i
Cells(i, 6) = Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")
Else
Cells(dic.Item(Cells(i, 1).Text), 6) = Cells(dic.Item(Cells(i, 1).Text), 6) & ", " & Format(Cells(i, 3), "dd/mm") & "->" & Format(Cells(i, 4), "dd/mm")[/COLOR]
End If
Next
Set dic = Nothing
End Sub
Chính là nó. Trước khi tới câu Add Cell(i,1).Text thì đoạn code có 1 Câu là Dic.Exists( Cells(i,1).Text ) thì cái kiểm tra chính là "Key"
2 cái này có thể bằng nhau hoặc không bằng nhau:
Chân thành cảm ơn Phước đã chia sẻ và góp ý nhé
. Em có gửi file excel đính kèm các Thầy xem giúp em.
Em làm 1 cái Form có nhiều CommandButton. Em muốn khi bấm Button1 thì nó làm ẩn và hiện 1 số Button khác và khi bấm Button2 thì làm ngược lại với Button1. Em làm cái vòng lặp mà sao nó cứ lỗi hoài
Private Sub CommandButton1_Click()
Dim i, a, b, c
For i = 4 To 11
ActiveSheet.UserForm1.CommandButton(i).Visible = True
Next
For a = 12 To 19
ActiveSheet.UserForm1.CommandButton(a).Visible = False
Next
For b = 8 To 15
ActiveSheet.UserForm1.Label(b).Visible = True
Next
For c = 16 To 23
ActiveSheet.UserForm1.Label(c).Visible = False
Next
End Sub
For i = 4 To 11
UserForm1.Controls("CommandButton" & i).Visible = True
NextSub B_tachdong()
Dim data(), Res(1 To 65536, 1 To 11)
Dim i, j, k, tam3, tam4, tam5, tam7
data = Sheet1.Range(Sheet1.[A7], Sheet1.[d65536].End(3).Offset(, 7)).Value
For i = 1 To UBound(data)
If InStr(1, data(i, 3), "+") Then
tam3 = Split(data(i, 3), "+")
tam4 = Split(data(i, 4), "+")
tam5 = Split(data(i, 5), "+")
tam7 = Split(data(i, 7), "+")
For ii = 1 To UBound(tam3) + 1
k = k + 1
For j = 1 To 11
Res(k, j) = data(i, j)
Next
Res(k, 3) = tam3(ii - 1)
Res(k, 4) = tam4(ii - 1)
Res(k, 5) = tam4(ii - 1)
If UBound(tam7) > 0 Then Res(k, 7) = tam7(ii - 1)
Next
Else
k = k + 1
For j = 1 To 11
Res(k, j) = data(i, j)
Next
End If
Next
Sheet3.[A7].Resize(k, 11) = Res
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim aa, bb, jj As Long
aa = Sheet1.UsedRange.Rows.Count
bb = Sheet2.UsedRange.Rows.Count
jj = 1
Do While jj <= bb
Range("b" & jj) = "=lookup(a" & jj & ",sheet1!a1:a" & aa & ",sheet1!b1:b" & aa & ")"
j = j + 1
Loop
End SubEm sửa lại rồi,nhưng khi nhập lần đầu thì nó chạy bình thường,còn nhập tiếp thêm 1 ô nữa thì chương trình vẫn không dừng được,anh cho em hỏi thêm 1 vấn đề nữa là khi em sử dụng lookup thì bi hạn chế trong vấn đề lookup-vectơ phải xắp xếp theo thứ tư tăng dần nên gây khó khăn trong việc trả kết quả đúng,anh có thể hướng dẫn em cách giải quyết không,em cảm ơn anh
Anh có thể nói kỹ hơn một tí được không,mình đưa 2 dòng trên vào chỗ nào của đoạn mã
Tổng quát là thế này. Tuy nhiên nhìn code của bạn là thấy không hợp lý rồi. Biến bb sẽ cho ra là 1 thì chạy Do Loop gì nữa
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'your code here.......................
Application.EnableEvents = True
End Sub
Private Sub CommandButton1_Click()
Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z
a = Worksheets("A").Range("A1048576").End(xlUp).Row - 2
Label22.Caption = a
b = Worksheets("B").Range("A1048576").End(xlUp).Row - 2
Label23.Caption = b
c = Worksheets("C").Range("A1048576").End(xlUp).Row - 2
Label24.Caption = c
d = Worksheets("D").Range("A1048576").End(xlUp).Row - 2
Label25.Caption = d
e = Worksheets("E").Range("A1048576").End(xlUp).Row - 2
Label26.Caption = e
f = Worksheets("F").Range("A1048576").End(xlUp).Row - 2
Label27.Caption = f
g = Worksheets("G").Range("A1048576").End(xlUp).Row - 2
Label28.Caption = g
h = Worksheets("H").Range("A1048576").End(xlUp).Row - 2
Label29.Caption = h
i = Worksheets("I").Range("A1048576").End(xlUp).Row - 2
Label30.Caption = i
j = Worksheets("J").Range("A1048576").End(xlUp).Row - 2
Label31.Caption = j
k = Worksheets("K").Range("A1048576").End(xlUp).Row - 2
Label32.Caption = k
l = Worksheets("L").Range("A1048576").End(xlUp).Row - 2
Label33.Caption = l
m = Worksheets("M").Range("A1048576").End(xlUp).Row - 2
Label34.Caption = m
n = Worksheets("N").Range("A1048576").End(xlUp).Row - 2
Label35.Caption = n
o = Worksheets("O").Range("A1048576").End(xlUp).Row - 2
Label36.Caption = o
p = Worksheets("P").Range("A1048576").End(xlUp).Row - 2
Label37.Caption = p
q = Worksheets("Q").Range("A1048576").End(xlUp).Row - 2
Label38.Caption = q
r = Worksheets("R").Range("A1048576").End(xlUp).Row - 2
Label39.Caption = r
s = Worksheets("S").Range("A1048576").End(xlUp).Row - 2
Label40.Caption = s
t = Worksheets("T").Range("A1048576").End(xlUp).Row - 2
Label41.Caption = t
u = Worksheets("U").Range("A1048576").End(xlUp).Row - 2
Label42.Caption = u
v = Worksheets("V").Range("A1048576").End(xlUp).Row - 2
Label43.Caption = v
w = Worksheets("W").Range("A1048576").End(xlUp).Row - 2
Label44.Caption = w
x = Worksheets("X").Range("A1048576").End(xlUp).Row - 2
Label45.Caption = x
y = Worksheets("Y").Range("A1048576").End(xlUp).Row - 2
Label46.Caption = y
z = Worksheets("Z").Range("A1048576").End(xlUp).Row - 2
Label47.Caption = z
Label48.Caption = a + b + c + d + e + f + g + h + i + j + k + l + m + n + o + p + q + r + s + t + u + v + w + x + y + z
End SubXin các Thầy xem giúp em có cách nào làm cho đoạn code này nó ngắn lại không ?
PHP:Private Sub CommandButton1_Click() Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z a = Worksheets("A").Range("A1048576").End(xlUp).Row - 2 Label22.Caption = a b = Worksheets("B").Range("A1048576").End(xlUp).Row - 2 Label23.Caption = b End Sub
Private Sub CommandButton1_Click()
Dim index As Long, curr_row As Long, sum_row As Long
For index = 65 To 90
curr_row = Worksheets(Chr(index)).Range("A1048576").End(xlUp).Row - 2
Controls("Label" & index - 43).Caption = curr_row
sum_row = sum_row + curr_row
Next index
Label48.Caption = sum_row
End Sub
. Nhìn code của Thầy thì em hiểu là trong mã ASCII số 65 là A... hihi
. Còn về khai báo biến thì thật tình em ko biết vì em ko có học bài bản VBA mà chỉ học từ những gì cần làm và hỏi các Thầy trên forum thôi 
. Cám ơn Thầy nhiều lắm 
Private Sub CommandButton1_Click()
Dim index As Long, curr_row As Long, sum_row As Long, Arr()
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For index = 0 To UBound(Arr)
curr_row = Worksheets(Arr(index)).Range("A1048576").End(xlUp).Row - 2
Controls("Label" & index + 22).Caption = curr_row
sum_row = sum_row + curr_row
Next index
Label48.Caption = sum_row
End SubPrivate Sub CommandButton10_Click()
Dim i As Long
Dim sh As WorkSheet
For i = 65 To 90
For Each sh In ThisWorkbook.Sheets
If UCase(sh.Name) = Chr(i) Then
Me.CommandButton10.Visible = False
Exit Sub
End If
Next
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Chr(i)
ActiveSheet.Range("A1") = "0" & Chr(i)
ActiveSheet.Range("A2") = "0" & Chr(i)
Next
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Number"
ActiveSheet.Range("A1") = "0A"
ActiveSheet.Range("A2") = "0A"
End SubPrivate Sub CommandButton10_Click()
Dim index As Long, sh As Worksheet, a
For index = 65 To 90
On Error Resume Next
a = Sheets(Chr(index)).[A1].Value
If Err.Number Then
Err.Clear
On Error GoTo 0
Set sh = Worksheets.Add
With sh
.Name = Chr(index)
.Range("A1").Value = Chr(index)
.Range("A2").Value = Chr(index)
End With
End If
Next index
' SortSheets
End SubGiả sử trong cửa sổ chính ta nhìn thấy 3 sheet theo thứ tự B, C, A và thao tác bằng tay ta kéo A lên đầu để các sheet theo thứ tự A, B, C. Bây giờ bạn muốn làm điều đó bằng code? Nếu thế thì: Alt + F11 --> Insert --> Module --> dán code sau vào Module1.
Sub SortSheets()
Dim k As Long, n As Long
For k = Sheets.Count To 2 Step -1
For n = 1 To k - 1
If [COLOR=#ff0000]Sheets(n).Name > Sheets(n + 1).Name[/COLOR] Then Sheets(n).Move After:=Sheets(n + 1)
Next n
Next k
End SubPrivate Sub CommandButton10_Click()
Dim index As Long, sh As Worksheet, a
For index = 65 To 90
On Error Resume Next
a = Sheets(Chr(index)).[A1].Value
If Err.Number Then
Err.Clear
On Error GoTo 0
Set sh = Worksheets.Add
With sh
.Name = Chr(index)
.Range("A1").Value = Chr(index)
.Range("A2").Value = Chr(index)
End With
End If
Next index
' SortSheets
End SubMột ký tự đầu? Bạn đọc ra bằng Left hoặc Mid. Còn kiểm tra? Hàm Asc/AscW(ký tự) sẽ trả về mã của "ký tự". Mã của chữ số là từ 48 tới 57 (tương ứng 0, 1, ..., 9), của A-Z là từ 65 tới 90, của a-z là từ 97 tới 122. Nếu Asc(ký tự) nằm trong mỗi khoảng ở trên thì "ký tự" là chữ số, thuộc A-Z, thuộc a-z
a = Sheets(Chr(index)).[A1].Value
Sub Ghep_So()
Dim dauso(), duoiso, kq(), i As Long, j As Long, n As Long
With Sheet4
duoiso = .Range(.[F3], .[F200].End(4)).Value
ReDim kq(1 To UBound(duoiso), 1 To 1)
dauso = .Range("A3:A74").Value
End With
For i = 1 To UBound(duoiso)
For j = 1 To UBound(dauso)
If duoiso(i, 1) <> "" Then
kq(j + n, 1) = dauso(j, 1) & duoiso(i, 1)
End If
Next
n = n + 72
Next
With Sheet4
.Range("G3:G10000").ClearContents
.Range("G3").Resize(i - 1, 1) = kq
End With
End SubBài này chỉ khó là khi ghép dãy 6 số để tạo ra những số gần giống chỉ sai duy nhất 1 số gần nhất.
Khó hiểu à nghe!
Tôi chạy code này kết quả cũng giống hệt của tác giả, không kịp chớp mắt là xong.
Gởi anh BaTê nhà mình cái vụ tại sao phải dùng Dic nha, nếu không anh sẽ ấm ức tại sao em lại nói như thế
Sub vlap()
Dim i As Long, j As Long
b = 1
For i = 97 To 122
For j = 97 To 122
Activesheet.Range("A" & b).Value = Chr(i) & Chr(j)
b = b + 1
Next j
Next i
End SubSub vlap()
Dim i As Long, j As Long, b
For i = 97 To 122
For j = 48 To 122
If j < 58 Or j > 96 Then
b = b + 1
ActiveSheet.Range("A" & b).Value = Chr(i) & Chr(j)
End If
Next j
Next i
End SubTrả lời liều chứ thật ra chả hiểu bạn muốn kết quả ra sao
Sub vlap()
Dim i As Long, j As Long, b
Dim res(1 To 65536, 1 To 1)
For i = 48 To 122
If i < 58 Or i > 96 Then
For j = 48 To 122
If j < 58 Or j > 96 Then
b = b + 1
res(b, 1) = Chr(i) & Chr(j)
End If
Next j
End If
Next i
[A1].Resize(b) = res
End SubActiveSheet.Range("A" & b).Value = Chr(i) & Chr(j)res(b, 1) = Chr(i) & Chr(j)
_ Còn đoạn kết trên của Thầy thì em thấy Thầy "Update" cái dòng :
thành :PHP:ActiveSheet.Range("A" & b).Value = Chr(i) & Chr(j)
_ Tốc độ nhanh lên thấy rõ luôn ghê thiệt... Cám ơn Thầy Hải nhiều lắmPHP:res(b, 1) = Chr(i) & Chr(j)
_ Haha Cám ơn Thầy nhiều nha, em cũng làm theo cái vụ "If" như Thầy thì ra kết quả cũng OK, chỉ tội là càng nhiều khoảng giá trị ko liền nhau thì càng nhiều "If"
_
Sub vlap()
Dim i As Long, j As Long, b As Long, ik As Long
Dim d1, c1, d2, c2, res(1 To 65536, 1 To 1)
d1 = Array(48, 48, 97, 97)
c1 = Array(57, 57, 122, 122)
d2 = Array(48, 97, 48, 97)
c2 = Array(57, 122, 97, 122)
For ik = 0 To Ubound(d1)
For i = d1(ik) To c1(ik)
For j = d2(ik) To c2(ik)
b = b + 1
res(b, 1) = Chr(i) & Chr(j)
Next j
Next i
Next ik
[A1].Resize(b) = res
End Sub_ Giải thích 1 chút về code trên được không Zerothink. Nhiều mảng quá nhìn ko hiểu gì luôn
For i = 48 To 57
For j = 48 To 57
b = b + 1
res(b, 1) = Chr(i) & Chr(j)
Next j
Next i For i = 48 To 57
For j = 97 To 122
b = b + 1
res(b, 1) = Chr(i) & Chr(j)
Next j
Next ic2 = Array(57, 122, 97, 122)c2 = Array(57, 122, 57, 122)Sub vlap()
Dim i As Long, j As Long, b As Long, ik As Long
Dim d1, d2, res(1 To 65536, 1 To 1)
d1 = [ { 48, 57; 48, 57; 97, 122; 97, 122 } ]
d2 = [ { 48, 57; 97, 122; 48, 97; 97, 122 } ]
For ik = 1 To UBound(d1)
For i = d1(ik, 1) To d1(ik, 2)
For j = d2(ik, 1) To d2(ik, 2)
...
End SubSub vlap2()
Dim name As String, b As Long, i As Long, j As Long
Dim res(1 To 1048576, 1 To 1)
name = UserForm1.TextBox5.Text
b = 1
For i = 0 To 9
For j = 0 To 9
b = b + 1
res(b, 1) = name & i & j
Next j
Next i
[A2].Resize(b) = res
Call ExportFile
End SubPHP:Sub vlap2() Dim name As String, b As Long, i As Long, j As Long Dim res(1 To 1048576, 1 To 1) name = UserForm1.TextBox5.Text b = 1 For i = 0 To 9 For j = 0 To 9 b = b + 1 res(b, 1) = name & i & j Next j Next i [A2].Resize(b) = res Call ExportFile End Sub
_ Em có đoạn code như trên và 1 cột H chứa nhiều tên, giờ em muốn cái "name" sẽ tự lấy từng tên trong cột H đó. (khỏi phải nhập tên từng người vào cái TextBox5 nữa. Nhưng em không biết làm sao để tạo vòng lặp đưa tên từng người vào. Xin các Thầy giúp em nha
. Các Thầy coi có gì góp ý hoàn thiện hơn giúp em nha Sub vlap2()
Dim name As String, b As Long, i As Long, j As Long
Dim res(1 To 1048576, 1 To 1), LastRow As Long, ik As Long
LastRow = Range("H1048576").End(xlUp).Row
For ik = 1 To LastRow
name = Sheets("Sheet1").Range("H" & ik).Text
b = 1
For i = 0 To 9
For j = 0 To 9
b = b + 1
res(b, 1) = name & i & j
Next j
Next i
[A2].Resize(b) = res
Call ExportFile
Next ik
End Sub
bằng cách bấm vào nút # trên khung trả lời (ở diễn đàn) khi viết bài
Còn upFile như bài trên [URL="http://www.giaiphapexcel.com/forum/member.php?853099-phucbugis"][B][B]phucbugis[/B][/B][/URL] đã nói, chắc file dung lượng to, thì up lên media file rui đưa link ra đây. vì trông vào code không khó đoán
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 SubHên xui nha
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 SubSub 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 SubFunction 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 Functionhà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.
Function LAY6SO(Cll As Range)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\D"
LAY6SO = Right(.Replace(Cll, ""), 6)
End With
End FunctionFunction LAY4SO(Cll As Range)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\D"
LAY4SO = Left(.Replace(Cll, ""), 4)
End With
End FunctionChuyển khai báo a, b vào trong () của hàm là được
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 FunctionFunction 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 FunctionFunction 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 FunctionSub 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 SubSub 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 SubTách ra 2 sự kiện:
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 SubPrivate 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
10 (hoặc D2, nếu chỉ muôn D2 thôi, khác D khác không làm)[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
[B]If Not Intersect(Target, [B1:B10]) Is Nothing Then Target.Offset(, 1) = Target + Target.Offset(, 1)[/B]
[B]End Sub[/B]
[B]Private Sub Worksheet_Change(ByVal Target As Range)
[/B][B]If Not Intersect(Target, [B1:B10]) Is Nothing Then Target.Offset(, 1) = Target + Target.Offset(, 1)
[/B] [B]End Sub[/B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim cll As Range
If Not Intersect(Target, [B1:B10]) Is Nothing Then
For Each cll In Target
cll.Offset(, 1) = cll + cll.Offset(, 1)
Next
End If
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim cll As Range
If Not Intersect(Target, Union([B1:B10], [f1:f10])) Is Nothing Then
For Each cll In Target
cll.Offset(, 1) = cll + cll.Offset(, 1)
Next
End If
End SubCái này cứ bật Record Macro rồi tiến hành Sort là nắm được thôi.Em có tìm kiếm phương thức Sort GPE nhưng không thấy.
Các anh chị giải thích về các thông số của phương thức Sort như trong hcho em với!!
Em xin cảm ơn!
[TABLE="width: 100%"]Em có tìm kiếm phương thức Sort GPE nhưng không thấy.
Các anh chị giải thích về các thông số của phương thức Sort như trong hcho em với!!
Em xin cảm ơn!
| Name | Required/Optional | Description |
|---|---|---|
Chẳng thấy cái file đính kèm của bạn đâu nên đoán bừa: Có thể hiện tại chỉ 1 mình sheet "wt" đang hiện, bây giờ bạn lại nhập số 0 vào ô D10, do đó phát sinh lỗi tại câu lệnh Sheets("wt").Visible = False vì nếu chạy câu này thì tất cả các sheet đều bị ẩn, bác Bill không chịu nên báo lỗi.
Trong file của bạn, tên sheet "Vibration Test" bị dư 1 dấu cách ở cuối, còn tên sheet "Aux.Speed Adj.Unit" thì dư 1 dấu cách ở đầu. Bạn xóa mấy cái dấu cách này đi là được, hoặc sửa trong code thành "Vibration Test " và " Aux.Speed Adj.Unit"
