Bác ndu96081631 xem hộ em sao em chạy nó lại bị đơ đơ và trắng màn hình post #805 với ạ!
ValidateList thấy lạ quá...
Sub SetDN()
Dim i As Integer
Dim lastRow As Long
Dim lastRow1 As Long
For i = 2 To 20
If Sheets("Pickticket").Range("A" & i).Value <> Empty Then
Sheets("Pickticket").Range("A" & i).Copy
Sheets("DN").Range("A2").PasteSpecial Paste:=xlPasteValues
Sheets("CTN_LPN_Checking").Range("A2").PasteSpecial Paste:=xlPasteValues
With Sheets("DN")
lastRow = .Range("A10").Value
.PageSetup.PrintArea = "C1:S" & lastRow
Range("D11:P11").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("DN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DN").Sort.SortFields.Add Key:=Range("D12:D500"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DN").Sort.SortFields.Add Key:=Range("F12:F500"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("DN").Sort
.SetRange Range("D11:P500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
With Sheets("DN").PageSetup
.PrintTitleRows = "$10:$10"
End With
With Sheets("CTN_LPN_Checking")
lastRow1 = .Range("A4").Value
.PageSetup.PrintArea = "C1:I" & lastRow1
End With
With Sheets("CTN_LPN_Checking").PageSetup
.PrintTitleRows = "$1:$6"
End With
Sheets("DN").Copy after:=Sheets("DN")
Sheets("CTN_LPN_Checking").Copy after:=Sheets("CTN_LPN_Checking")
End If
Next i
End SubHình như phải vầy anh à
Thầy chỉnh thì chắc là ok rồi.
Em nghĩ vấn đề không ở code mà là ở cái Shape anh vẽ trên bảng tính. Anh thử thay nó bằng Button (Form Controls) xem sao
Em thấy hơi lạ khi anh bảo "cái cần không thấy".
SendKey thì cửa sổ nào đang active (hiện hành) thì nó send key tại cửa sổ đó.
Thế thì anh chưa đọc hết topic đó rồi. Ngay bài #1 của topic đó có nói SendKey bị "mất phím Numlock". Không tin anh kiểm tra Numlock sau mỗi lần SendKey xem.
With Sheets("N")
R = .Range("AL60000").End(xlUp).Row
If R > 4 Then
sArr = .Range("AL4:AL" & R).Resize(, 16).Value
ReDim tArr(1 To UBound(sArr), 1 To 16)
For i = 2 To UBound(sArr)
If Not Dic.Exists(sArr(i, 1)) Then
k = k + 1
Dic.Item(sArr(i, 1)) = k
tArr(k, 1) = sArr(i, 1)
End If
For j = 6 To 16
If sArr(1, j) = "P" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "NC" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "N" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "BH" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "CN" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "M7" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "TM" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "KH" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "SP" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "DN" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
ElseIf sArr(1, j) = "LT" Then
tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
End If
Next j
Next i
End If
.Range("AM13").Resize(k, 6) = tArr
End With'Ngay nghi....................................................................
If sArr(i, j) = "LT" Then
dArr(k, 6) = dArr(k, 6) + 1
If Dic.Exists(sArr(i, 4)) Then dArr(k, 6) = dArr(k, 6) + tArr(Dic.Item(sArr(i, 1)), 16)
Bạn đưa 1 file hồi "Chí Phèo ở truồng" rồi hỏi, ai mà biết file của bạn làm gì,.
File "giả lập" của bạn mà áp dụng được vào file thật thì là "Siêu" luôn.
Hix.. Em hỏi ở mấy # trước, rồi đến mấy # sau của anh gì đó cũng chưa có ai hồi âm giúp đỡ nên em hối vậy ạ. Hihi. Giúp em đi mấy anh ơi!!
If Dic.Exists(sArr(I, 4)) Then
Rws = Dic.Item(sArr(I, 4))
For J = 6 To 9
If tArr(Rws, J) > 0 Then dArr(K, J) = tArr(Rws, J)
Next J
For J = 7 To 16
If tArr(Rws, J) > 0 Then dArr(K, J + 1) = tArr(Rws, J)
Next J
End If If Dic.Exists(sArr(I, 4)) Then 'Neu ton tai key sArr(I,4) thi
Rws = Dic.Item(sArr(I, 4)) 'Gan sArr(I,4) thanh Item
For J = 6 To 9 'Xet cot tu 6 den 9 tuong duong cot EK den EO cua sheet BCC
If tArr(Rws, J) > 0 Then dArr(K, J) = tArr(Rws, J)
Next J
For J = 7 To 16 'Xet cot tu 7 den 16--> cai nay em khong hieu em tuong tu 11 den 17?
If tArr(Rws, J) > 0 Then dArr(K, J + 1) = tArr(Rws, J) 'Vu J+1 em cung khong hieu tai sao?
Next J
End IfHi đúng rồi anh ạ nhưng em chưa hiểu cái vụ xét J từ 7 đến 16, và vụ J+1 anh giải thích cho em hiểu với nhé.
Hình như có nhầm lẫn ở bài trên, tôi xóa file đính kèm,, bạn xem lại flle này:
Bạn thích "hu hu" nhưng lại viết không đầu không đuôi, sau bài viết của người khác, người khác cứ nghĩ là bạn "nhắc" mọi người giúp bài của bạn "tueyennhi".
Có cách nào để nhìn xem đó là bài # bao nhiêu không anh? Em on điện thoại ko làm sao biết bài em đã nhờ là bài # mấy cả, dù nó nằm ở trang 42, có đính kèm file tên là BTD.rar và cả file ảnh có nội dung code nữa.. Hix..
Hi, em chưa hiểu ý anh lắm nhưng cảm ơn anh nhé
.Thế này thì em tìm #xxx ở đâu đây?
Cái này lẽ nào là cái đang còn phải chỉnh lại của mấy anh xây dựng web.
bài của "thangteo" đây các anh các chị ạ
Cảm ơn anh nhiều ạ. Like, like,... Nhờ mọi người xử lý giúp.
Cell link của Combobox Form Controls sẽ trả về chỉ số (index) của combobox còn LinkedCell của Combobox ActiveX Controls trả về giá trị của combobox. Hai đối tượng này trả về hai dạng giá trị khác nhau nên nếu bạn dùng chung 1 thủ tục (sub) thì chắc chắn kết quả sẽ khác nhau (trường hợp cụ thể của bạn là 1 cái được và 1 cái lỗi).
Riêng máy tôi cả 2 chạy đều báo lỗi hết, Chổ Combobox1 của bạn bỏ đi chổ LinkedCell (của bạn để là K1, bây giờ xóa nó đi), vào code trong sheet bạn thêm vào dòng lệnh như sau:
Private Sub ComboBox1_Change()
[K1].Value = ComboBox1.ListIndex + 1
Call crane
End SubAnh Thắng ơi, giúp em chỉnh code ở #835 với. (Em có gửi Mail cho anh mà không thấy hồi âm). Rất mong sự giúp đỡ của anh ạ.
Bạn đã yêu cầu xóa đề tài thì tôi nghĩ chắc tất cả đã xong rồi. Sao bạn còn hỏi về cái file đó nữa?
Topic này có nhiều thông tin hữu ích. Tôi không muốn chỉ vì tôi giúp bạn mà topic này bị xóa
Hixx.. Dạ vâng, có gì không đúng mong anh và mọi người đừng chấp và thông cảm. Cảm ơn ạ.Bạn đã yêu cầu xóa đề tài thì tôi nghĩ chắc tất cả đã xong rồi. Sao bạn còn hỏi về cái file đó nữa?
Topic này có nhiều thông tin hữu ích. Tôi không muốn chỉ vì tôi giúp bạn mà topic này bị xóa
Sheets("INPUT").Select
Selection.AutoFilter Field:=4
Call timdulieu
Sheets("INPUT").Select
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Call noiluc
Call luccat
Call lucxoan
Sheets("INPUT").Select
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Sheets("NOILUC").Select
ActiveSheet.Range(Cells(1, 1), Cells(5000, 14)).Select
Selection.Copy
Sheets("THUYET MINH").Select
Range("K9").Select
ActiveSheet.Paste
End SubAnh thử xem lại xem sheet THUYET MINH đó có dấu cách hay không.
Chẳng biết có đúng không nhưng rút gọn lại như dưới, nếu không nó sẽ giật giật như đèn nháy...
Sheets("INPUT").AutoFilter Field:=4
Call timdulieu
Sheets("INPUT").AutoFilter Field:=3
Sheets("INPUT").AutoFilter Field:=4
Call noiluc
Call luccat
Call lucxoan
Sheets("INPUT").AutoFilter Field:=3
Sheets("INPUT").AutoFilter Field:=4
Sheets("NOILUC").Range(Cells(1, 1), Cells(5000, 14)).Copy Sheets("THUYET MINH").Range("K9").PasteLàm gì có vụ TextBox1.Activate hả bạn? Có chăng là TextBox1.SetFocus thì được
Public Static Sub Abcxyz()
MsgBox "OK"
End SubCái ni chắc lại réo anh VetMini lên thôi
Quá đơn giản, nó cho biết rằng tất cả các biến cục bộ trong sub đều là static ( được giữ lại giá trị sau các lần gọi). nếu thủ tục cần có 10 biến static, nếu gõ 10 cái static cũng lâu, thay vào đó gõ một cái là được.
static thì mình biết ... Còn bạn giải thích nghe chưa thuyết phục lắm
sư phụ em bảo thế. lúc nào rảnh viết code là hiểu liền
Static Sub ton30sthuthoi()
Dim a, b
a = a + 1
b = b + 1
Debug.Print a, b
End SubMình mới Thử Run 1 cái nó ra như hình nè ...Run cái nữa nó + 1Thay vì họanh họe người có chút thành ý chia sẻ , tôi bỏ ra 30s thử viết cái này
và thu được kết quả sau 6 phát runPHP:Static Sub ton30sthuthoi() Dim a, b a = a + 1 b = b + 1 Debug.Print a, b End Sub
1 1
2 2
3 3
4 4
5 5
6 6
Hay phết NguyenNgocThuHien nhở! Cơ mà sư phụ của cô là ai thế?
Đừng sợ chuột hư nhé ! Nhấp thêm phát thứ 2, thứ 3.... xem nó có phóng ra thêm gì không? Mạnh dạn nhấp vào!
dùng static trong class thì còn nhiều điều hấp dẫn hơn nhiều.Thay vì họanh họe người có chút thành ý chia sẻ , tôi bỏ ra 30s thử viết cái này
và thu được kết quả sau 6 phát runPHP:Static Sub ton30sthuthoi() Dim a, b a = a + 1 b = b + 1 Debug.Print a, b End Sub
1 1
2 2
3 3
4 4
5 5
6 6
Hay phết NguyenNgocThuHien nhở! Cơ mà sư phụ của cô là ai thế?
Cái ni chắc lại réo anh VetMini lên thôi
Kiểm tra lại Class3, thành viên chitiet xem có lỗi gì không?
Option Explicit
Sub noibang1()
Dim sFile As String, sSheet As String, sAddr As String
sFile = ThisWorkbook.Path & "\ky1.xlsx"
sSheet = "G000141"
sAddr = "C19:I785"
Range("A1:G767") = GetData(sFile, sSheet, sAddr)
End Sub
Sub noibang2()
Dim sFile As String, sSheet As String, sAddr As String
sFile = ThisWorkbook.Path & "\ky2.xlsx"
sSheet = "G000141"
sAddr = "C19:I785"
Range("I1:O767") = GetData(sFile, sSheet, sAddr)
End Sub
Sub noibang3()
Dim sFile As String, sSheet As String, sAddr As String
sFile = ThisWorkbook.Path & "\ky3.xlsx"
sSheet = "G000141"
sAddr = "C19:I785"
Range("Q1:W767") = GetData(sFile, sSheet, sAddr)
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
Arr = Range(sAddr)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To Range(sAddr).Rows.Count
For iC = 1 To Range(sAddr).Columns.Count
Arr(iR, iC) = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, iC).Address(, , 2))
Next iC
Next iR
GetData = Arr
End If
End FunctionOption Explicit
Sub noibang123(byVal soBang As Integer)
Dim sFile As String, sAddr As String
Select Case soBang
Case 1
sFile = ThisWorkbook.Path & "\ky1.xlsx"
sAddr = "A1"
Case 2
sFile = ThisWorkbook.Path & "\ky2.xlsx"
sAddr = "I1"
Case 3
sFile = ThisWorkbook.Path & "\ky3.xlsx"
sAddr = "Q1"
Case Else
Exit Sub
End Select
Range(sAddr).Resize(767,7) = GetData(sFile,"G000141","C19:I785")
End Sub
Sub noibang1()
noibang123 1
End Sub
Sub noibang2()
noibang123 2
End Sub
Sub noibang3()
noibang123 3
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
' Khong cần sửa, vả lại ai biết bạn muốn làm gì mà sửa
End FunctionÀ mình muốn copy dữ liệu tự động từ 3 file ky1,2,3 (vùng dữ liệu giống nhau là C19:I785, tên sheet giống nhau là G000141) vào chung 1 sheet ở file thứ 4.
À vâng, mình gửi kèm file bạn xem giùm với ạ
Function GPE2(Rng As Range, SP As String, Num As Long)
Dim frng As Range
Set frng = Rng.Resize(, 1).Find(SP, , xlValues, xlWhole, , , True)(, 2)
GPE2 = IIf(frng > Num Or frng(, 2) < Num, Space(0), frng + Num - 1)
Set frng = Nothing
End FunctionHay!, GPE2 nó lại vô tình trùng với địa chỉ của ô GPE2. Sửa nó thành GPE_2 xem, mà cũng chả hiểu hàm của bạn nó làm cái gì nữa.
