Vùng N:U là kết quả mong đợi. Dữ liệu đầu vào là D:K
(*) Bạn cần tìm trên cột nào của CSDL; Đừng nói là tìm ở bất kỳ cột nào trong CSDL đó nha.
Đúng là e định tìm bất cứ cột nào ấy. Nhưng cũng có thể thu gọn lại với vài cột thôi cũng dc. Hi
vâng những phần nhập kia e làm cơ bản rồi. chỉ đang mắc ở chỗ tìm kiếm, sửa, cập nhật thôi ạ.
cám ơn bác, e sẽ nghiên cứu file gợi ý của bác. có gì nhờ bác giúp đỡ tiếp nhé
Chỉnh sửa dựa trên code có sẵn.
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
If KeyCode = 13 Then
KeyCode = 0
If TextBox1.Value > "" Then
With ActiveCell
.Value = ActiveSheet.ListBox1.Column(0, 0)
.Offset(1, 0) = ActiveSheet.ListBox1.Column(1, 0)
Hide
.Offset(1).Select
End With
End If
End If
Application.ScreenUpdating = True
End SubChỉnh vài sub
Private Sub ListBox1_Click()
Dim i
i = ListBox1.ListIndex
Range("E6") = Sheet1.ListBox1.List(i, 0)
Range("E7") = Sheet1.ListBox1.List(i, 1)
Range("E7").Activate
Hide
End Sub
Private Sub thaydoi()
With Sheet1.TextBox1
.Visible = False
.Visible = True
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Width = ActiveCell.Width
.Height = ActiveCell.Height
.Value = ""
.Activate
End With
With Sheet1.ListBox1
.Visible = False
.Visible = True
.ColumnCount = 2
.Left = ActiveCell.Offset(, 1).Left
.Width = ActiveCell.Width * 1.5
.Height = 150
.Top = ActiveCell.Offset(, 1).Top
.Clear
End With
End Sub
Private Sub loc()
Dim sArr(), Arr(), Res(), i As Long, k As Long, tmp As String, maHang As String
With Sheet2
sArr = .Range("M6:N74").Value
End With
ReDim Arr(0 To UBound(sArr), 1 To 2)
Sheet1.ListBox1.Clear
tmp = UCase(TV(Sheet1.TextBox1.Value))
For i = 1 To UBound(sArr)
maHang = sArr(i, 1)
If maHang <> "" Then
If UCase(TV(maHang)) Like "*" & tmp & "*" Then
Arr(k, 1) = maHang
Arr(k, 2) = sArr(i, 2)
k = k + 1
End If
End If
Next
ReDim Res(0 To k, 1 To 2)
For i = 0 To k
Res(i, 1) = Arr(i, 1): Res(i, 2) = Arr(i, 2)
Next i
Sheet1.ListBox1.List = Res
End SubChưa kiểm tra kỹ, code Enter lấy giá trị trên cùng của Listbox bị lỗi khi Textbox có giá trị không nằm trong dữ liệu.
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
If KeyCode = 13 Then
KeyCode = 0
If TextBox1.Value > "" Then
If ActiveSheet.ListBox1.ListCount > 0 Then
With ActiveCell
.Value = ActiveSheet.ListBox1.Column(0, 0)
.Offset(1, 0) = ActiveSheet.ListBox1.Column(1, 0)
Hide
.Offset(1).Select
End With
End If
End If
End If
Application.ScreenUpdating = True
End SubCó sửa mấy chỗ, bạn xem file đính kèm nhe.
Xin chào Anh leonguyenz,
Đã sửa cột số lượng, xem trong file đính kèm nhe.
Xin cảm ơn Anh leonguyenz rất nhiều.
Thêm dòng sau vào nhé:
.ColumnWidths = "40;100;50"Cảm ơn Anh leonguyenz, nhiều ạ.
With Sheet2
dl = .[M6:P74].Value
End WithWith Sheet2
dl = .[M5:P74].Value
End WithCảm ơn thuyyeu99 đã quan tâm,
Không biết có phải vậy không ạ? , nếu đúng như vậy thì trường hợp muốn sử dụng với RowSource thì code phải ra sao. Híc
Hihi lâu rồi mình không dùng tới mấy cái control trong excel nên mình cũng không nhớ rõ nữa. Mình nhớ mang máng bài viết của anh hoàng trong nghĩa có úp code đo, còn nếu bạn muốn đẹp thì dùng listview de hiển thị (ma nó không hien thi duoc unicode), còn gán dữ liệu thì cứ từ array ma gán xuống sheet
Dạ vâng, OT cảm ơn leonguyenz đã giúp đỡ.
Dữ liệu đưa ra ngoài sheet (cột MNO, đang để ẩn).
OT Thấy rồi ạ,
Tmp = Sheet1.Range("M6").Resize(j, 3).Address(0, 0)
'ActiveSheet.ListBox1.List = kQ
ActiveSheet.ListBox1.ListFillRange = Tmp
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Sub ymdID()
Dim MaKH As String, MaYMD As String, MaTam As String, MyAdd As String
Dim Cls As Range, Rng As Range, sRng As Range
Dim Rws As Long, Num As Integer
On Error Resume Next
With Sheets("YMD")
Rws = .[d1].CurrentRegion.Rows.Count
Set Rng = .[B1].Resize(Rws)
Rng.Offset(, -2).Value = Space(0)
For Each Cls In .Range(.[d2], .[d2].End(xlDown))
MaYMD = idYMD(Cls.Value)
Set sRng = Rng.Find(MaYMD, , xlFormulas, xlPart)
If sRng Is Nothing Then
Cls.Offset(, -2).Value = MaYMD & "00"
Else
MyAdd = sRng.Address
Do
MaTam = sRng.Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Num = CInt(Right(MaTam, 2)) + 1
Cls.Offset(, -2).Value = MaYMD & Right("0" & CStr(Num), 2)
Num = 0
End If
Next Cls
End With
End SubFunction idYMD(Optional Dat As Date)
If Dat = 0 Then Dat = Date
idYMD = Mid(Alf, Year(Dat) - 2000, 1) & Mid(Alf, Month(Dat) + 1, 1)
idYMD = idYMD & Mid(Alf, Day(Dat) + 1, 1)
End Function
Cảm ơn bạn đã giúp đỡ.
Mọi người bớt chút thời gian giúp em vấn đề này với. Thanks
Chuyện của bạn không khó; Mà bạn tự làm khó mình bằng cách trộn ô (như [A3]của trang 'In . . "
Em rất cám ơn anh đã dành thời gian giúp đỡ em xin trả lời các vấn đề như sau:
- Em rất cảm ơn anh đã thiết kế lại giúp em. Đây là sai sót của em khi tạo file dữ liệu để nhờ mọi người giúp. Trong thực tế file của em sẽ có thêm 1 sheet Thông tin khách hàng, và các dữ liệu như Tên, số đt, địa chỉ giao hàng sẽ được lấy ở đấy để cho vào sheet In Đơn Hàng.
)Anh ơi, code của anh thật tuyệt, nhưng trình của em kém nên chỉ hiểu đc 1 ít không thể sửa để nó chạy theo ý mình được. Nhưng em thấy file của anh hiện có mấy vấn đề không hợp lắm:
(0) Có` thể chưa hợp với bạn lúc này; Nhưng nếu thêm 1 công đoạn nữa, như lập danh sách duy nhất từ cột mả ĐH & đem qua cập nhật bên trang 'GPE' thì sao? Chuyện cập nhật này luôn sẩy ra khi ta dóng trang CSDL lại.
Mã KH Tên KH
NVH00 Nguyễn Việt Hồng
NVH01 Ngô Thị Việt Hà
FFDOO Đỗ Đình Dương
FJT00 Đinh Trọng
. . . . . .Private Sub Worksheet_Change(ByVal Target As Range)
1 If Not Intersect(Target, [J3]) Is Nothing Then
Dim WF As Object, Rng As Range, sRng As Range
3 ReDim Arr(1 To 9, 1 To 22)
Dim Rws As Long, W As Integer
5 Dim MyAdd As String
Set WF = Application.WorksheetFunction
7 [B12:w20].Value = Arr()
Rows("11:20").Hidden = False '** '
9 With Sheets("DHang")
Rws = .[A2].CurrentRegion.Rows.Count
11 Set Rng = .[A2].Resize(Rws)
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
13 If sRng Is Nothing Then
MsgBox "Nothing"
15 Else
MyAdd = sRng.Address
17 Do
W = W + 1: Arr(W, 1) = W
19 Arr(W, 2) = .Cells(sRng.Row, "F").Value
Arr(W, 7) = .Cells(sRng.Row, "G").Value
21 Arr(W, 14) = .Cells(sRng.Row, "H").Value
Arr(W, 16) = .Cells(sRng.Row, "I").Value
23 Arr(W, 19) = .Cells(sRng.Row, "J").Value
Arr(W, 22) = .Cells(sRng.Row, "K").Value
25 If W = 1 Then
[U6].Value = sRng.Offset(, 1).Value: [U7].Value = sRng.Offset(, 2).Value
27 End If
Set sRng = Rng.FindNext(sRng)
29 Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
If W Then
31 [B12].Resize(W, 22).Value = Arr()
Rows(W + 12 & ":20").Hidden = True '** '
33 End If
End If
35 End With
End If
End Sub
Cám ơn a đã giúp e ạ, e đã hiểu về vấn đề này, nhưng cho e hỏi thêm là dialogsheet có sử dụng nhiều k ạ, e thấy e dùng userform ổn hơn
24: Tương tự D19 tương ứngAnh ơi, cái lệnh này có tác dụng gì thế anh[#253]
D1: Điều kiện nếu bạn mó tới ô [J3] thì thực hiện các lệnh tiếp theo cho đến D36
D2: Khai báo 3 tham biến đối tượng
D3: Khai bào 1 biến mảng gồm 9 dòng & 22 cột.
D4: Khai báo 2 tham biến kiểu số Long & Integer
D5: Khai báo 1 tham biến chứa chuỗi kí tự
D6: Gán đối tượng hàm Excel vô tham biến
D7: Vùng ô [B12:W20] được gán tử mảng (chưa có dữ liệu; Thực chất là xóa trắng vùng dữ liệu)
D8: Cho hiện các dòng từ 11 – 20
D9: Tuyên cáo làm việc với trang tính có tên ‘DHang’
D10 Lấy số dòng của vùng dữ liệu xung quanh [B2] gán vô tham biến
D11: Lấy vùng từ [A2] mở rọng xuống dưới với số dòng vừa xác định gán vô biến đối tương (Range)
D12: Áp dụng phương thức tìm kiếm trị ta vừa nhập (vô ô [J3]), khu vực tìm là vùng dòng 11 vừa xác định
D13: Nếu tìm không thấy thì báo cho biết ở D14
D15 Bằng ngược lại thì thực hiện các lệnh dưới liền kề cho tới D34
D16: Lấy địa chỉ ô vừa tìm thấy gán vô tham biến (kiểu chuỗi)
D17: Tạo vòng lập thực hiện việc tìm kiếm; Vòng lặp kết thúc tại D29
D18: (mệnh đề đầu)Thêm 1 đơn vị cho biến đếm
(mệnh đề sau) Lấy chỉ số này gán ngay vô phần từ đầu tiên bên trái nhất của mảng
D19: Lấy trị trong ô có số dòng trùng với dòng tìm thấy & cột ‘F’ đem gán cho phần tử thuộc dòng W & cột là 2 của mảng
D20
D25: Điều kiện khi biến đếm =1 thì thực hiện 2 câu lệnh của dòng tiếp sau
D26 M1: Ô [U6] được gán trị của ô liền kề bên phải ô tìm thấy
M2: Ô U7 thì lại gán tiếp ô bên phải kế tiếp
D27: Kết thúc Đ/K (dòng 25)
D28 Thực hiện phương thức tìm tiếp
D29 Điều kiện kết thúc vòng lặp (là địa chỉ tìm thấy đầu tiên đã được ghi vô biến chuỗi)
D30 Điều kiện là tìm thấy dữ liệu thì thực hiện 2 dòng lệnh tiếp sau ; Kết thúc ĐK ở D33
D31: Gán vùng dữ liệu đang có trên mảng lên trang tính
D32” Ẩn những dòng trống/rỗng dữ liệu trên dòng 21 của trang
Sub TaoDH()
Rows("3:3").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Range("B3").Value = ""
Application.CutCopyMode = False
Range("C3").Value = ""
Range("D3").Value = ""
Range("F3").Value = ""
Range("G3").Value = ""
Range("H3").Value = ""
Range("I3").Value = ""
Range("J3").Value = ""
Range("L3").Value = ""
Range("M3").Value = ""
Range("N3").Value = ""
Range("P3").Value = ""
Range("Q3").Value = ""
Range("R3").Value = ""
Range("S3").Value = ""
End SubSub TaoDH()
Rows("3:3").Insert Shift:=xlDown
[A3].Value = [A4].Value: [e3].Value = [E4].Value
[k3].Value = [k4].Value: [o3].Value = [O4].Value
Exit Sub
End SubAnh ơi. Nếu insert như thế này thì các định dạng và công thức ở 1 số ô có đc giữ nguyên ko anh
- Làm như thế này không được anh ạ. Vì như thế các định dạng ô sẽ không đc giữ nguyên, thêm nữa nó sẽ lấy định dạng của dòng phía trên ( A2). Ví dụ như dòng A2 đang là dòng tiêu đề, em có to màu đỏ toàn bộ dòng, khi insert kiểu này thì dòng insert ra cũng sẽ bị tô màu theo.
Sub Sort()
Dim dong_cuoi As Long
dong_cuoi = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Range("A3", "S" & dong_cuoi).Select
Sheet1.Sort.SortFields.Clear
Sheet1.Sort.SortFields.Add Key:=Range("A3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheet1.Sort
.SetRange Range("A3", "S" & dong_cuoi)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows(dong_cuoi).Select
Exit Sub
End SubAnh ơi cho em hỏi 1 tí. Em tạo 1 cái Button khi bấm sẽ chạy đoạn code sau để copy 1 dòng rồi insert nó tại vị trí đó.
Sub TaoDH()
Dim dong_cuoi As Long
dong_cuoi = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Rows(dong_cuoi).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Range("B" & dong_cuoi + 1, "D" & dong_cuoi + 1).Value = ""
Range("F" & dong_cuoi + 1, "J" & dong_cuoi + 1).Value = ""
Range("L" & dong_cuoi + 1).Value = ""
Range("N" & dong_cuoi + 1).Value = ""
Range("P" & dong_cuoi + 1).Value = ""
Range("R" & dong_cuoi + 1).Value = ""
Range("S" & dong_cuoi + 1).Value = ""
Exit Sub
End SubSelection.Insert Shift:=xlDown
Góp ý cho bạn:
cám ơn anh rất nhiều ạ! tại em muốn nó hiện vô textbox để coppy dữ liệu ạ! list box copy k đc tiện!
Cũng tiện mà, Copy từ Array í thôi (Nhờ ListIndex của ListBox)!
Private Sub timinv_Change()
Dim Rng As Range, sRng As Range
Dim lRs As Long, J As Long, W As Integer
Dim MyAdd As String
With Sheets("INV")
lRs = .[B1].CurrentRegion.Rows.Count
Set Rng = .[B1].Resize(lRs)
ReDim Arr(1 To lRs, 1 To 7)
If Len(Me!TimInv.Text) = 4 Then
Set sRng = Rng.Find(Right("000" & Me!TimInv.Text, 7), , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing!"
Else
MyAdd = sRng.Address
Do
W = W + 1: Arr(W, 1) = W
Arr(W, 2) = sRng.Offset(, -1).Value: Arr(W, 3) = sRng.Value
Arr(W, 4) = sRng.Offset(, 3).Value: Arr(W, 5) = sRng.Offset(, 4).Value
Arr(W, 6) = sRng.Offset(, 10).Value: Arr(W, 7) = sRng.Offset(, 12).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Me!lbTim.List = Arr() '<=| <=| <=| <=| <=| '
End If
End If
End With
End Sub
Sub diendulieu()
On Error Resume Next
Sheets(Data).Select
Dim i As Long
If Range("K" & i + 5).Value = "" Then Exit Sub
For i = 1 To Range("K10000").End(xlUp).Row - 5
Range("D" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 2, 0)
Range("E" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 3, 0)
Range("F" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 4, 0)
Range("L" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 6, 0)
Range("O" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 5, 0)
Range("J" & i + 5).Value = WorksheetFunction.VLookup(Range("P" & i + 5).Value, Sheet7.Range("H3:I400"), 2, 0)
Next
End SubKhoan hãy nói về Code của bạn;
Theo gợi ý của bạn mình đã code cho nó điền luôn khi ấn insert tuy nhiên nó hiện lỗi N/A mà chưa hiểu vì sao. minh kiểm tra thấy giá trị tìm kiếm và giá trị ở bảng tra cứu là cùng kiểu số rồi. hic. Bạn giúp mình xem lại code với
With Sheet1
.Range("K" & dong_cuoi) = txtQHNS.text
.Range("C" & dong_cuoi) = txtQD.text
.Range("D" & dong_cuoi) = Application.VLookup(txtQHNS.text, Sheet7.Range("B3:G400"), 2, 0)
.Range("E" & dong_cuoi) = Application.VLookup(txtQHNS.text, Sheet7.Range("B3:G400"), 3, 0)
.Range("F" & dong_cuoi) = Application.VLookup(txtQHNS.text, Sheet7.Range("B3:G400"), 4, 0)
.Range("G" & dong_cuoi) = Replace(txtSotien.text, Mid(Format(1234, "#,##0"), 2, 1), "")
.Range("H" & dong_cuoi) = txtKy.text
.Range("I" & dong_cuoi) = txtLoai.text
.Range("J" & dong_cuoi) = Application.VLookup(txtNguon.text, Sheet7.Range("H3:I400"), 2, 0)
.Range("L" & dong_cuoi) = Application.VLookup(txtQHNS.text, Sheet7.Range("B3:G400"), 6, 0)
.Range("P" & dong_cuoi) = txtNguon.text
.Range("M" & dong_cuoi) = txtKhoan.text
.Range("N" & dong_cuoi) = txtCTMT.text
.Range("O" & dong_cuoi) = Application.VLookup(txtQHNS.text, Sheet7.Range("B3:G400"), 5, 0)
.Range("Q" & dong_cuoi) = txtDuphong.text
.Range("R" & dong_cuoi) = txtMaGD.text
End Withthử thì Excel bị đơ luôn, Alt + F4 thì out ra vào báo lỗi VBA Can't quit at this time rồi tắt hẳn excel
Tìm thuộc tính (Properties) của UserForm là ShowModal, chọn False.
tôi đã làm như vậy
Cám ơn @ongke0711
ôi ôi, tôi chỉ là dân nghiệp dư
Cám ơn bác, để tôi ngâm thử.
Dim lnghWnd As Longthì khi chạy trên Office 2016 sẽ có lỗi ở
SendMessage lnghWnd, WM_SETICON, False, lngIconhoặc (lParam truyền bởi giá trị)
gạch đá càng nhiều càng tốt !
