Nhờ anh chị giúp đoạn code cho form nhập dữ liệu.

vietthanhbk · 11/8/10

Em mới tập tành vào VBA nhưng làm hoài không biết làm sao cho nó chạy được, em nhờ anh chị trong giải pháp làm giúp được không ah! hoặc làm cho em vài ví dụ cũng được ! Thanks anh chị nhiều +-+-+-+

MinhCong · 13/8/10

Đã gởi file lên mà không có 1 số liệu gì cả, ít ra cũng phải có số liệu như thế nào, yêu cầu lấy từ đâu...chứ để không không vậy ai mà hiểu. List(1,2,3,4)....là cái gì?

vietthanhbk · 13/8/10

Em viết được 1 đoạn rồi nhưng giờ em muốn chèn thêm 1 ô MKH nửa, Khi nhập dúng MKH thì Tên Khách hàng và Tên công trỉnh hiện ra luôn không cần phải đánh máy. Nhờ anh chi trong GPE chỉ giúp

MinhCong · 14/8/10

vietthanhbk đã viết:
Em viết được 1 đoạn rồi nhưng giờ em muốn chèn thêm 1 ô MKH nửa, Khi nhập dúng MKH thì Tên Khách hàng và Tên công trỉnh hiện ra luôn không cần phải đánh máy. Nhờ anh chi trong GPE chỉ giúp

Bài của Bạn Tôi thấy chỉ cần dùng hàm VLOOKUP là được mà cần gì code nhỉ?

concogia · 14/8/10

vietthanhbk đã viết:
Em viết được 1 đoạn rồi nhưng giờ em muốn chèn thêm 1 ô MKH nửa, Khi nhập dúng MKH thì Tên Khách hàng và Tên công trỉnh hiện ra luôn không cần phải đánh máy. Nhờ anh chi trong GPE chỉ giúp

Chưa hiểu rõ ý định của bạn, nhưng tạm thời có thể thay code này vào cái nút của bạn cho nó gọn hơn tí tẹo

Mã:

Private Sub CommandButton1_Click()
 If Application.WorksheetFunction.CountA(Range("b3:b12")) < 10 Then MsgBox "Nhap lieu du di bo teo": Exit Sub
    With Range("B3:B12")
        .Copy
            Sheets("Bang Tong Hop").[b500].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        .ClearContents
    End With
End Sub

Còn cái mã Kh gì đó bạn làm thử xem sao
Thân

vietthanhbk · 14/8/10

Bây giờ mình đã viết được 1 form và code cho nó rồi nhưng nó không save vào hàng tiếp theo được mà cứ ghi đè lên hàng cũ , Bạn nào có thể sửa giúp mình được không

sealand · 14/8/10

Code nhập viết lòng vòng quá. Bạn thử thay code này xem sao:

Mã:

Sub NhapLieu()
Dim Rg As Range
Set Rg = Sheet2.[a65536].End(xlUp).Offset(1)
Rg = Rg.Row - 3
For i = 1 To 12
Rg.Offset(, i) = Sheet1.Cells(i + 2, 2)
Next
Sheet1.[b3:b13].ClearContents
End Sub

vietthanhbk · 14/8/10

Mình thử xài code của bạn rồi nhưng sao nó vẫn ghi đè len số liệu cũ, nó không xuống dòng khác được. Với lại dữ liệu nhập vào ở những cột cách nhau, làm nhưng bạn nó liền nhau, mình khó xử lý dữ liệu lắm.... Bạn có cách nào viết tiếp đoạn code của mình mà nó save dữ liệu ở hàng kế tiếp không

concogia · 14/8/10

vietthanhbk đã viết:
Mình thử xài code của bạn rồi nhưng sao nó vẫn ghi đè len số liệu cũ, nó không xuống dòng khác được. Với lại dữ liệu nhập vào ở những cột cách nhau, làm nhưng bạn nó liền nhau, mình khó xử lý dữ liệu lắm.... Bạn có cách nào viết tiếp đoạn code của mình mà nó save dữ liệu ở hàng kế tiếp không

Sửa lại cho bạn tí tẹo cho nó nhận ở hàng tiếp theo nhé, còn nguyên xi code của bạn (tại bạn đổi cấu trúc của bảng nên thành dài dòng, nhưng mà của mình làm vẫn thích hé)

Mã:

Sub NhapLieu()
    Sheets("Form").Select
    TR = Range("B3").Value
    KH = Range("B4").Value
    CT = Range("B5").Value
    HM = Range("B6").Value
    Mac = Range("B7").Value
    ND = Range("B8").Value
    NN = Range("B9").Value
    Lfour = Range("B10").Value
    LTeenfour = Range("B11").Value
    TT = Range("B12").Value
    NV = Range("B13").Value
    Sheets("Bang Tong Hop").Select
    [b500].End(xlUp).Offset(1, 0).Select
    ActiveCell.Offset(, 0).Value = TR
    ActiveCell.Offset(, 4).Value = KH
    ActiveCell.Offset(, 5).Value = CT
    ActiveCell.Offset(, 6).Value = HM
    ActiveCell.Offset(, 7).Value = Mac
    ActiveCell.Offset(, 1).Value = ND
    ActiveCell.Offset(, 2).Value = NN
    ActiveCell.Offset(, 8).Value = Lfour
    ActiveCell.Offset(, 9).Value = LTeenfour
    ActiveCell.Offset(, 13).Value = TT
    ActiveCell.Offset(, 14).Value = NV
    Sheets("Form").Select
    Range("B3:B13").Select
    Selection.ClearContents
    Range("B3").Select
    End Sub

Thân

Ếch Xanh · 14/8/10

concogia đã viết:

Sửa lại cho bạn tí tẹo cho nó nhận ở hàng tiếp theo nhé, còn nguyên xi code của bạn (tại bạn đổi cấu trúc của bảng nên thành dài dòng, nhưng mà của mình làm vẫn thích hé)

Mã:

Sub NhapLieu()
Sheets("Form").Select
TR = Range("B3").Value
KH = Range("B4").Value
CT = Range("B5").Value
HM = Range("B6").Value
Mac = Range("B7").Value
ND = Range("B8").Value
NN = Range("B9").Value
Lfour = Range("B10").Value
LTeenfour = Range("B11").Value
TT = Range("B12").Value
NV = Range("B13").Value
Sheets("Bang Tong Hop").Select
[b500].End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(, 0).Value = TR
ActiveCell.Offset(, 4).Value = KH
ActiveCell.Offset(, 5).Value = CT
ActiveCell.Offset(, 6).Value = HM
ActiveCell.Offset(, 7).Value = Mac
ActiveCell.Offset(, 1).Value = ND
ActiveCell.Offset(, 2).Value = NN
ActiveCell.Offset(, 8).Value = Lfour
ActiveCell.Offset(, 9).Value = LTeenfour
ActiveCell.Offset(, 13).Value = TT
ActiveCell.Offset(, 14).Value = NV
Sheets("Form").Select
Range("B3:B13").Select
Selection.ClearContents
Range("B3").Select
End Sub

Thân

Bác Cò ui, sao Bác "Select" nhiều "thía"?

Mượn code của Bác em làm cho nó "sáng" một chút nè!

PHP:

Sub NhapLieu()
  With Sheets("Form")
    TR = .Range("B3").Value
    KH = .Range("B4").Value
    CT = .Range("B5").Value
    HM = .Range("B6").Value
    Mac = .Range("B7").Value
    ND = .Range("B8").Value
    NN = .Range("B9").Value
    Lfour = .Range("B10").Value
    LTeenfour = .Range("B11").Value
    TT = .Range("B12").Value
    NV = .Range("B13").Value
  End With
 
  With Sheets("Bang Tong Hop").[B500].End(xlUp).Offset(1, 0)
    .Offset(, 0).Value = TR
    .Offset(, 4).Value = KH
    .Offset(, 5).Value = CT
    .Offset(, 6).Value = HM
    .Offset(, 7).Value = Mac
    .Offset(, 1).Value = ND
    .Offset(, 2).Value = NN
    .Offset(, 8).Value = Lfour
    .Offset(, 9).Value = LTeenfour
    .Offset(, 13).Value = TT
    .Offset(, 14).Value = NV
  End With
 
  Sheets("Form").Range("B3:B13").ClearContents
  'Neu bat buoc phai select thi tiep tuc:
  Sheets("Form").Select
  Range("B3").Select
End Sub

-------------------------------------------

Ẹc ... Ẹc .... Lẽ ra cái "nì" phải làm bằng UserForm thích hợp hơn nhỉ?

boyxin · 14/8/10

vietthanhbk đã viết:
Bây giờ mình đã viết được 1 form và code cho nó rồi nhưng nó không save vào hàng tiếp theo được mà cứ ghi đè lên hàng cũ , Bạn nào có thể sửa giúp mình được không

Vui quá, ở đây vui quá. Em góp vui 1 đoạn code, nhờ các bác kiểm tra giúp xem có rắc rối rì không nhen

PHP:

Sub NhapLieu()
Dim Arr(), ArrKQ(1 To 1, 1 To 15)
With Sheet1
    Arr = .[B3].Resize(11).Value
    ArrKQ(1, 1) = Arr(1, 1)
    ArrKQ(1, 5) = Arr(2, 1)
    ArrKQ(1, 6) = Arr(3, 1)
    ArrKQ(1, 7) = Arr(4, 1)
    ArrKQ(1, 8) = Arr(5, 1)
    ArrKQ(1, 2) = Arr(6, 1)
    ArrKQ(1, 3) = Arr(7, 1)
    ArrKQ(1, 9) = Arr(8, 1)
    ArrKQ(1, 10) = Arr(9, 1)
    ArrKQ(1, 14) = Arr(10, 1)
    ArrKQ(1, 15) = Arr(11, 1)
    Sheet2.[B3].End(xlDown).Offset(1).Resize(, 15) = ArrKQ
    .[B3:B13].ClearContents: .[B3].Select
End With
End Sub

Ếch Xanh · 14/8/10

boyxin đã viết:
Vui quá, ở đây vui quá. Em góp vui 1 đoạn code, nhờ các bác kiểm tra giúp xem có rắc rối rì không nhen

PHP:

Sub NhapLieu() Dim Arr(), ArrKQ(1 To 1, 1 To 15) With Sheet1 Arr = .[B3].Resize(11).Value ArrKQ(1, 1) = Arr(1, 1) ArrKQ(1, 5) = Arr(2, 1) ArrKQ(1, 6) = Arr(3, 1) ArrKQ(1, 7) = Arr(4, 1) ArrKQ(1, 8) = Arr(5, 1) ArrKQ(1, 2) = Arr(6, 1) ArrKQ(1, 3) = Arr(7, 1) ArrKQ(1, 9) = Arr(8, 1) ArrKQ(1, 10) = Arr(9, 1) ArrKQ(1, 14) = Arr(10, 1) ArrKQ(1, 15) = Arr(11, 1) Sheet2.[B3].End(xlDown).Offset(1).Resize(, 15) = ArrKQ .[B3:B13].ClearContents: .[B3].Select End With End Sub

Đúng là đàn anh viết Code mà! Nhưng em nghĩ sẽ có một chỗ bị lỗi nếu ActiveSheet không phải là Sheet1, bởi không thể cho cái vụ này đi chung được:
With Sheet1
.......
.[B3].Select
End With

Mà phải là Sheet1.Select rồi mới đến [B3].Select

Em nói vậy đúng không đại ca? hihihi (lâu lâu để đàn em bắt giò hehehe)

sealand · 14/8/10

vietthanhbk đã viết:
Mình thử xài code của bạn rồi nhưng sao nó vẫn ghi đè len số liệu cũ, nó không xuống dòng khác được. Với lại dữ liệu nhập vào ở những cột cách nhau, làm nhưng bạn nó liền nhau, mình khó xử lý dữ liệu lắm.... Bạn có cách nào viết tiếp đoạn code của mình mà nó save dữ liệu ở hàng kế tiếp không

Đáng lẽ ra tôi sẽ không viết bài này, nhưng vẫn phải tham gia với bạn vì nó có điều gì đó làm người giúp bạn hơi buồn:
Tôi nói buồn vì bạn xem bài tôi gửi vào lúc mấy giờ. Như vậy tôi không ngủ trưa ngồi viết bài, test bài rồi gửi cho bạn vậy mà bạn không Test lại trả lời "vô tư" như vậy.
Tôi đặt ô đích bằng câu lệnh, mà bạn bảo nó chép đề vào dữ cũ của bạn là không thể

Set Rg = Sheet2.[a65536].End(xlUp).Offset(1)

Còn cách dòng thì bạn đâu có nói, nếu nói thì đâu có vấn đề gì đâu, sửa offset là xong.Bạn vẫn thừa công đoạn vùng sang Array và từ Array

Set Rg = Sheet2.[a65536].End(xlUp).Offset(2)

Còn số thứ tự thì sửa
Rg = Rg.Row - 3 thành Rg = Int((Rg.Row - 2)/2)

Tính tôi hay nói thẳng, cách của bạn là rót rượu từ chai nọ sang chai kia. Tại sao không rót thẳng mả lại đổ ra bát rồi từ bát đổ vào chai. Bạn gán thẳng vùng nọ = vung kia chứ sao phải gán ra biến.
Tôi tham gia vậy, còn dùng thế nào là tùy bạn. Có gì không phải mong thông cảm cho.

P/s:Boyxin à, cho 1 biến chạy là xong sao lại phải ngồi viêt hàng chục dòng lệnh thế. Đã thế, bạn lại ngồi chuyển ra mảng rồi từ mảng đổ vào.

Thôi thì mình nói nốt, mình đinh đưa bài mới và mình cho là cách này hay hơn nhưng vào thấy như thế này, bạn xem có nhanh hơn nhiều không:

Mã:

Sub NhapLieu()
Dim rg As Range
Set rg = Sheet2.[a65536].End(xlUp).Offset(2)
rg = Int((rg.Row - 2) / 2)
rg.Offset(,1).Resize.(, 9) = WorksheetFunction.Transpose(Sheet1.Range("B3:B12"))
Sheet1.Range("B3:B12").ClearContents
Sheet1.[b3].Select
End Sub

Ghi chú: Mình chưa kiểm tra chính sác ô chưa nhưng đó chỉ là hiệu chỉnh thôi.
Có 2 ô cuối cách cột gài lại 1 chút là được thôi mà

vietthanhbk · 14/8/10

Mình xin vô cùng cảm ơn anh Concogia, Learning_Excel và anh Boyxin suốt ngày nha. Mấy anh viết rất hay và đúng ý của em... Em cũng muốn lập User Form nhưng kiến thức hạn hẹp quá nên không làm được , em lập form đã đời rồi nhưng không biết liên kết sao nên đành viết cái này, anh nào giỏi về món này có thể giúp em vài chiêu được không ah.

boyxin · 14/8/10

Learning_Excel đã viết:
Đúng là đàn anh viết Code mà! Nhưng em nghĩ sẽ có một chỗ bị lỗi nếu ActiveSheet không phải là Sheet1, bởi không thể cho cái vụ này đi chung được:
With Sheet1
.......
.[B3].Select
End With

Mà phải là Sheet1.Select rồi mới đến [B3].Select

Em nói vậy đúng không đại ca? hihihi (lâu lâu để đàn em bắt giò hehehe)

Chẹp chẹp
code ở đây là dùng cho cái file người ta đính kèm, dùng thế này cũng được

With ActiveSheet
.......
.[B3].Select
End With

Nếu muốn nói ĐÚNG thì dài tập lắm +-+-+-+

Đơn cử 1 vis dụ: Nếu là Sheet1.Select rồi mới đến [B3].Select

Nhỡ không may ai đó táy máy đổi tên không còn sheet1 nữa thì select cái rì đây --=0

sealand đã viết:
P/s:Boyxin à, cho 1 biến chạy là xong sao lại phải ngồi viêt hàng chục dòng lệnh thế.

Hai mảng DỌC - NGANG thứ tự lộn xộn, cho biến chạy thế nào? (hơn chục dòng nhưng toàn là Copy, Paste, thấy cũng lẹ)
Chả nhẽ chạy 1 đoạn ngắn rồi IF (ngắt) rồi lại chạy tiếp ak?

xin được mách nước để sửa chữa

vietthanhbk · 14/8/10

Xin Lổi Bạn Sealand nha! Tài mình không biết áp dụng nó nhưng thế nào, Hay nói cách khác Là mình không biết mấy vụ này nên thất lễ, Thành thật xin lổi bạn nha.

Ếch Xanh · 14/8/10

boyxin đã viết:
Chẹp chẹp
code ở đây là dùng cho cái file người ta đính kèm

Nếu muốn nói ĐÚNG thì dài tập lắm

Đơn cử 1 vis dụ: Nếu là Sheet1.Select rồi mới đến [B3].Select

Nhỡ không may ai đó táy máy đổi tên không còn sheet1 nữa thì select cái rì đây

Em lại táy máy tay chân nữa rồi nè, viết em viết không được chứ phá em giỏi lắm! Lại mượn code của đại ca em phá tiếp nè hihihhi

PHP:

Sub NhapLieu()
Dim Arr(), ArrKQ(1 To 1, 1 To 15)
With Sheet1
  Arr = .[B3].Resize(11).Value
  ArrKQ(1, 1) = Arr(1, 1)
  ArrKQ(1, 5) = Arr(2, 1)
  ArrKQ(1, 6) = Arr(3, 1)
  ArrKQ(1, 7) = Arr(4, 1)
  ArrKQ(1, 8) = Arr(5, 1)
  ArrKQ(1, 2) = Arr(6, 1)
  ArrKQ(1, 3) = Arr(7, 1)
  ArrKQ(1, 9) = Arr(8, 1)
  ArrKQ(1, 10) = Arr(9, 1)
  ArrKQ(1, 14) = Arr(10, 1)
  ArrKQ(1, 15) = Arr(11, 1)
  Sheet2.[B3].End(xlDown).Offset(1).Resize(, 15) = ArrKQ
  .[B3:B13].ClearContents
  .Select
  .[B3].Select
  ActiveWindow.ScrollRow = 3
End With
End Sub

Em thêm cái "nì" vào cho "đẽe": ActiveWindow.ScrollRow = 3

boyxin · 14/8/10

Learning_Excel đã viết:
Em lại táy máy tay chân nữa rồi nè, viết em viết không được chứ phá em giỏi lắm! Lại mượn code của đại ca em phá tiếp nè hihihhi

PHP:

Sub NhapLieu() Dim Arr(), ArrKQ(1 To 1, 1 To 15) With Sheet1 Arr = .[B3].Resize(11).Value ArrKQ(1, 1) = Arr(1, 1) ArrKQ(1, 5) = Arr(2, 1) ArrKQ(1, 6) = Arr(3, 1) ArrKQ(1, 7) = Arr(4, 1) ArrKQ(1, 8) = Arr(5, 1) ArrKQ(1, 2) = Arr(6, 1) ArrKQ(1, 3) = Arr(7, 1) ArrKQ(1, 9) = Arr(8, 1) ArrKQ(1, 10) = Arr(9, 1) ArrKQ(1, 14) = Arr(10, 1) ArrKQ(1, 15) = Arr(11, 1) Sheet2.[B3].End(xlDown).Offset(1).Resize(, 15) = ArrKQ .[B3:B13].ClearContents .Select .[B3].Select ActiveWindow.ScrollRow = 3 End With End Sub

Em thêm cái "nì" vào cho "đẽe": ActiveWindow.ScrollRow = 3

Mất công táy máy thì thế này cho nó đẽe một thể

PHP:

Const ir = "0102030405060708091011"
Const ic = "0105060708020309101415"
Sub NhapLieu()
Dim Arr(), ArrKQ(1 To 1, 1 To 15)
With ActiveSheet
    Arr = .[B3].Resize(11).Value
For i = 1 To 21 Step 2
    jr = Mid(ir, i, 2) 
    jc = Mid(ic, i, 2) 
    ArrKQ(1, jc) = Arr(jr, 1)
Next
  .[B3:B13].ClearContents: .[B3].Select
  ActiveWindow.ScrollRow = 3
End With
Sheet2.[B3].End(xlDown).Offset(1).Resize(, 15) = ArrKQ
End Sub

sealand · 14/8/10

Mình trách Boyxin nha!!! Rõ ràng Boyxin hiểu bụng mình mà Boyxin còn hỏi lại mình bài #15. Boyxin dùng chuỗi dể tách đúng như ý mình nhưng không giống cách làm mà thôi. mình làm thế này:

dim mg()
mg=Array(1,5,6,7,8,2,3,9,10,14,15)
Tương ứng với i ta có giá trị mg(i) khỏi hàm tách chuỗi và đổi chuỗi thành số

Nhưng mình thắc mắc là file gốc mình tải về đâu có vấn đề này
Mình gửi lại các bạn xem có đúng không

boyxin · 14/8/10

sealand đã viết:
Mình trách Boyxin nha!!! Rõ ràng Boyxin hiểu bụng mình mà Boyxin còn hỏi lại mình bài #15. Boyxin dùng chuỗi dể tách đúng như ý mình nhưng không giống cách làm mà thôi. mình làm thế này:

dim mg()
mg=Array(1,5,6,7,8,2,3,9,10,14,15)
Tương ứng với i ta có giá trị mg(i) khỏi hàm tách chuỗi và đổi chuỗi thành số

Nhưng mình thắc mắc là file gốc mình tải về đâu có vấn đề này
Mình gửi lại các bạn xem có đúng không

Khà khà, đang học hỏi mà (ĐB vấn đề về mảng), không hỏi vậy thì sao biết thêm được phần chữ mầu đo đỏ trên kia

Cảm ơn bác đã chỉ bảo tận tình. Mong Bác chỉ bảo thêm

PHP:

Sub NhapLieu()
Dim Arr(), ArrKQ(1 To 1, 1 To 15), mg()
    mg = Array(, 1, 5, 6, 7, 8, 2, 3, 9, 10, 14, 15)
With ActiveSheet
    Arr = .[B3].Resize(11).Value
    For i = 1 To 11
        ArrKQ(1, mg(i)) = Arr(i, 1)
    Next
    .[B3:B13].ClearContents: .[B3].Select
    ActiveWindow.ScrollRow = 3
End With
With Sheet2.[B3].End(xlDown)
    .Offset(1, -1) = .Offset(, -1) + 1
    .Offset(1).Resize(, 15) = ArrKQ
    .Offset(, 3).Copy .Offset(1, 3)
    .Offset(, 10).Resize(, 3).Copy .Offset(1, 10).Resize(, 3)
End With
End Sub

-----
Phần cuối

With Sheet2.[B3].End(xlDown)
.Offset(1, -1) = .Offset(, -1) + 1
.Offset(1).Resize(, 15) = ArrKQ
.Offset(, 3).Copy .Offset(1, 3)
.Offset(, 10).Resize(, 3).Copy .Offset(1, 10).Resize(, 3)
End With

Chưa ưng ý. Mong được các bác góp ý thêm

Nhờ anh chị giúp đoạn code cho form nhập dữ liệu.

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên gắn bó

Gội rồi mới Cạo

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Gội rồi mới Cạo

Thành viên tích cực

Members actively

Thành viên tích cực

Thành viên gạo cội

Thành viên mới

Members actively

Thành viên mới

Thành viên tích cực

Members actively

Thành viên gạo cội

File đính kèm

Members actively

File đính kèm

Đếm ngược thời gian