Dữ liệu nhảy cách nhau

  • Thread starter Thread starter NH_DK
  • Ngày gửi Ngày gửi
Liên hệ QC
NH_DK

NH_DK

Let's patience
Tham gia
29/7/10
Bài viết
865
Được thích
1,203
Nghề nghiệp
Kế toán
Code của em sao chỗ nào mà nó lại nhảy cách nhau như vậy? (Xem trong mục Database)

PHP: 
Option Explicit
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S1.Range(S1.[A3], S1.[a65000].End(xlUp))
  If S1.Range("G1") = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR Is Nothing Then
     With S5
       i = .[A50000].End(xlUp).Row + 1
      .Cells(i, 1).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 0).Resize(, 1).Value
      .Cells(i, 2).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 1).Resize(, 1).Value
      .Cells(i, 3).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 2).Resize(, 1).Value
      .Cells(i, 4).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 3).Resize(, 1).Value
      .Cells(i, 5).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 4).Resize(, 1).Value
      .Cells(i, 6).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 5).Resize(, 1).Value
      'S1.Range("A3:F20").ClearContents
    End With
 Else
    MsgBox "HAVE A GOOD TIME!", vbCritical, "MINDA VIETNAM CO.,LTD"
 End If
End Sub
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
NH_DK đã viết:
Code của em sao chỗ nào mà nó lại nhảy cách nhau như vậy? (Xem trong mục Database)

PHP: 
Option Explicit
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S1.Range(S1.[A3], S1.[a65000].End(xlUp))
  If S1.Range("G1") = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR Is Nothing Then
     With S5
       i = .[A50000].End(xlUp).Row + 1
      .Cells(i, 1).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 0).Resize(, 1).Value
      .Cells(i, 2).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 1).Resize(, 1).Value
      .Cells(i, 3).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 2).Resize(, 1).Value
      .Cells(i, 4).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 3).Resize(, 1).Value
      .Cells(i, 5).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 4).Resize(, 1).Value
      .Cells(i, 6).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 5).Resize(, 1).Value
      'S1.Range("A3:F20").ClearContents
    End With
 Else
    MsgBox "HAVE A GOOD TIME!", vbCritical, "MINDA VIETNAM CO.,LTD"
 End If
End Sub
Nhấp chuột vào đây để mở rộng...
Qua code trên anh không hiểu em làm gì nhưng có ý kiến như sau
1.
PHP: 
 Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
Tương đương
PHP: 
 Set Rng = S1.Range(S1.[A3], S1.[A20].End(xlUp).Offset(1))
Ý em là sao?
2.
PHP: 
 .Cells(i, 1).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 0).Resize(, 1).Value
      .Cells(i, 2).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 1).Resize(, 1).Value
      .Cells(i, 3).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 2).Resize(, 1).Value
      .Cells(i, 4).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 3).Resize(, 1).Value
      .Cells(i, 5).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 4).Resize(, 1).Value
      .Cells(i, 6).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 5).Resize(, 1).Value
Sao em không dùng:
PHP: 
For j=1 to 6
   .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j-1).Resize(, 1).Value
Next
 
Lần chỉnh sửa cuối:
Upvote 0
NH_DK đã viết:
Code của em sao chỗ nào mà nó lại nhảy cách nhau như vậy? (Xem trong mục Database)

PHP: 
Option Explicit
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S1.Range(S1.[A3], S1.[a65000].End(xlUp))
  If S1.Range("G1") = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR Is Nothing Then
     With S5
       i = .[A50000].End(xlUp).Row + 1
      .Cells(i, 1).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 0).Resize(, 1).Value
      .Cells(i, 2).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 1).Resize(, 1).Value
      .Cells(i, 3).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 2).Resize(, 1).Value
      .Cells(i, 4).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 3).Resize(, 1).Value
      .Cells(i, 5).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 4).Resize(, 1).Value
      .Cells(i, 6).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 5).Resize(, 1).Value
      'S1.Range("A3:F20").ClearContents
    End With
 Else
    MsgBox "HAVE A GOOD TIME!", vbCritical, "MINDA VIETNAM CO.,LTD"
 End If
End Sub
Nhấp chuột vào đây để mở rộng...
xem code của a Ngọc em thấy có hai vấn đề làm nó nhảy dòng:
1/ là do tiêu đề vùng "a1:BB2" A megcell---> sai với kiểu .end(xlup) không nên megcell.
2/ dòng này : i = .[A50000].End(xlUp).Row + 1 sửa lại thành :
 i = .[A50000].End(xlUp).Row --->ok
Nhìn code đúng là hoa cả mắt.(PM:dạo này bác bận gì mà thỉnh thoảng gọi cafe khó thật)
 
Upvote 0
Em sửa thế này:
PHP: 
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&, j&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S5.Range(S5.[A2], S5.[a65000].End(xlUp)).Offset(1)
  If S1.Range("G1").Value = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR Is Nothing Then
    With S5
        i = .[A50000].End(xlUp).Row
        For j = 1 To 6
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
          'S1.Range("A3:F20").ClearContents
    End With
 Else
    MsgBox "HAVE A GOOD TIME!", vbCritical, "MINDA VIETNAM CO.,LTD"
 End If
End Sub
Nhưng vẫn không ổn?
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
NH_DK đã viết:
Em sửa thế này:
PHP: 
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&, j&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S5.Range(S5.[A2], S5.[a65000].End(xlUp)).Offset(1)
  If S1.Range("G1").Value = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR Is Nothing Then
    With S5
        i = .[A50000].End(xlUp).Row
        For j = 1 To 6
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
          'S1.Range("A3:F20").ClearContents
    End With
 Else
    MsgBox "HAVE A GOOD TIME!", vbCritical, "MINDA VIETNAM CO.,LTD"
 End If
End Sub
Nhưng vẫn không ổn?
Nhấp chuột vào đây để mở rộng...
A vẫn còn để megcell kìa? vì thế nên dòng đầu của CSDL luôn nhảy lên dòng tiêu đề.Ở sheet CSDL Anh bỏ megcell hết đi và dòng tiêu đề để sao cho( "A2:G2" có kí hiệu <>"") Là ok.
-Pm: A thiết kế kiểu này liệu hợp lý chưa nhỉ? nếu người dùng nhỡ tay nhấn làm phát 3 lần cái save luôn một lúc? liệu lúc đó thế nào? chắc CSDL toi luôn.
+ em thấy ở sheet in và sheets CSDL cấu trúc giống nhau sau không dùng rng.ADDRESS cho nó chuyển dữ liệu từ sheet in sang sheet csdl luôn?
 
Lần chỉnh sửa cuối:
Upvote 0
khoavu87 cho mình hỏi thêm chút xíu nữa nha:
Tại ô G1 mình nhập là IN thì cập nhật bình thường rùi. Nhưng nếu mình muốn nhập OUT để cột số lượng của nó cập nhập sang cột ISSUE của mục Database thì mình đswuar code thế này:
PHP: 
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&, j&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S5.Range(S5.[A3], S5.[a65000].End(xlUp))
  If S1.Range("G1").Value = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR.Value = "IN" Then 'Is Nothing Then
    With S5
        i = .[A50000].End(xlUp).Row
        For j = 1 To 6
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
    End With
  Else
    With S5
        For j = 1 To 5
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
            .Cells(i, 7).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 6).Resize(, 1).Value
    End With
  End If
End Sub
Nhưng nó vẫn không ổn?
 

File đính kèm

Upvote 0
NH_DK đã viết:
khoavu87 cho mình hỏi thêm chút xíu nữa nha:
Tại ô G1 mình nhập là IN thì cập nhật bình thường rùi. Nhưng nếu mình muốn nhập OUT để cột số lượng của nó cập nhập sang cột ISSUE của mục Database thì mình đswuar code thế này:
PHP: 
Sub Ghi()
  Dim Rng As Range, MyRng As Range, MyR As Range
  Dim dongdau&, i&, j&
  On Error Resume Next
  Set Rng = S1.Range(S1.[A2], S1.[A20].End(xlUp)).Offset(1)
  dongdau = Rng.Rows.Count
  Set MyRng = S5.Range(S5.[A3], S5.[a65000].End(xlUp))
  If S1.Range("G1").Value = "" Then MsgBox "Pls enti code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
  Set MyR = MyRng.Find(S1.[G1].Value, , xlValues, xlWhole)
  If MyR.Value = "IN" Then 'Is Nothing Then
    With S5
        i = .[A50000].End(xlUp).Row
        For j = 1 To 6
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
    End With
  Else
    With S5
        For j = 1 To 5
            .Cells(i, j).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, j - 1).Resize(, 1).Value
        Next
            .Cells(i, 7).Offset(1, 0).Resize(dongdau).Value = Rng.Offset(, 6).Resize(, 1).Value
    End With
  End If
End Sub
Nhưng nó vẫn không ổn?
Nhấp chuột vào đây để mở rộng...
Phần lấy dữ liệu từ S1 sang S5 sao tôi thấy nó lủng củng quá. Sao không là vầy:
PHP: 
S5.Range("A60000").End(xlUp).Offset(1).Resize(1000, 6).Value = S1.Range("A3:F1003").Value
1 dòng code duy nhất
 
Upvote 0
Sao của em vẫn bị lỗi:
PHP: 
Sub Ghi()
  Dim Rng As Range
  Application.ScreenUpdating = False
  On Error Resume Next
  Set Rng = S1.Range("G1")
  With S5
    If Rng.Value = "IN" Then
      .Range("A60000").End(xlUp).Offset(1).Resize(1000, 6).Value = S1.Range("A3:F20").Value
    ElseIf Rng.Value = "OUT" Then
      .Range("A60000").End(xlUp).Offset(1).Resize(60000, 5).Value = S1.Range("A3:E20").Value
      .Range("A60000").End(xlUp).Offset(1).Offset(-2, 6).Resize(60000, 1).Value = S1.Range("F3:F20").Value
    Else
      MsgBox "Pls choose code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
    End If
  End With
  S1.Range("A2:F20").ClearContents
  Set Rng = Nothing
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
NH_DK đã viết:
Sao của em vẫn bị lỗi:
PHP: 
Sub Ghi()
  Dim Rng As Range
  Application.ScreenUpdating = False
  On Error Resume Next
  Set Rng = S1.Range("G1")
  With S5
    If Rng.Value = "IN" Then
      .Range("A60000").End(xlUp).Offset(1).Resize(1000, 6).Value = S1.Range("A3:F20").Value
    ElseIf Rng.Value = "OUT" Then
      .Range("A60000").End(xlUp).Offset(1).Resize(60000, 5).Value = S1.Range("A3:E20").Value
      .Range("A60000").End(xlUp).Offset(1).Offset(-2, 6).Resize(60000, 1).Value = S1.Range("F3:F20").Value
    Else
      MsgBox "Pls choose code IN or OUT", vbCritical, "MINDA VIETNAM CO.,LTD": Exit Sub
    End If
  End With
  S1.Range("A2:F20").ClearContents
  Set Rng = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Sửa
PHP: 
S1.Range("A2:F20").ClearContents
Thành:
PHP: 
S1.Range("A3:F20").ClearContents
thử xem nhé
 
Upvote 0
Cám ơn anh @viehoai nhiều! Nhưng em đã sửa rùi mà vẫn chưa được? Em muốn khi chọn ở ô G1 (mục P/O) là IN thì số lượng sẽ cập nhập vào cột Incoming (Database). Và ngược lại, nếu chọn OUT thì số lượng sẽ cập nhật vào cột Issue (Database). Nhưng hiện tại nó nhảy chưa đúng ý ah!
 
Upvote 0
NH_DK đã viết:
Cám ơn anh @viehoai nhiều! Nhưng em đã sửa rùi mà vẫn chưa được? Em muốn khi chọn ở ô G1 (mục P/O) là IN thì số lượng sẽ cập nhập vào cột Incoming (Database). Và ngược lại, nếu chọn OUT thì số lượng sẽ cập nhật vào cột Issue (Database). Nhưng hiện tại nó nhảy chưa đúng ý ah!
Nhấp chuột vào đây để mở rộng...
Cái này nếu tôi nhớ không lầm thì đã làm cho bạn rồi...
Chuyện quá nhỏ, bạn cũng rành VBA, tự nghiên cứu xem (chỉ 1 cái IF tùy thuộc vào G1 sẽ quyết định chuyển số lượng vào đâu)
Bạn máy móc quá... Hic...
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

V
Cho 2 biến - kết quả trả về giá trị của hàng đầu tiên
    • Chấp nhận
Trả lời
4
Đọc
40
vic_it
V
D
Giúp đỡ thống kê dữ liệu theo điều kiện
Trả lời
8
Đọc
157
HieuCD
H
Mr.hieudoanxd
  • Question Question
[Cần hướng dẫn] Về lập trình Viết Function với Settimer và Killtimer
    • Thích
Trả lời
2
Đọc
132
Mr.hieudoanxd
Mr.hieudoanxd
bachloc1212
Đưa Text từ các dòng khác nhau về chung 1 dòng
Trả lời
10
Đọc
197
VetMini
V
N
Sửa lỗi code vba khi chạy cho ra kết quả không đúng
Trả lời
6
Đọc
143
VetMini
V
Ha Manh-LD
  • Question Question
Lấy dữ liệu từ file csv
Trả lời
1
Đọc
99
ptm0412
ptm0412
T
Nhờ hỗ trợ hàm SUMIF không phân biệt được các ký tự "0" trước một số trong chuỗi
Trả lời
2
Đọc
110
VetMini
V
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
13
Đọc
405
LuuAnh980
LuuAnh980
HeSanbi
  • Đã giải quyết
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
9
Đọc
844
HeSanbi
HeSanbi
Tienvinh191
  • Question Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
28
Đọc
2K
quyenpv
quyenpv
F
Hiển thị text trong Gantt chart (Google sheets)
Trả lời
0
Đọc
50
FATA11
F
Maika8008
  • Đã giải quyết
[Chia sẻ] Dùng VBA trộn dữ liệu Excel sang file Word mẫu (tương tự chức năng Mail Merge)
    • Thích
    • Yêu thích
    • Cảm ơn
25 26 27
Trả lời
522
Đọc
50K
Manhhung90
Manhhung90
C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
5
Đọc
213
VetMini
V
C
  • Question Question
import data từ excel lên google sheet
Trả lời
5
Đọc
619
SonBDND
S
ptm0412
Chúc mừng năm mới Ất Tỵ 2025
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
1
Đọc
148
ptm0412
ptm0412
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
2
Đọc
958
thopd
T
mucongnghenhat
lỗi đoạn văn bản bị đóng khung
Trả lời
2
Đọc
129
VetMini
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
307
Đọc
22K
kunkoi9390
K
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
6
Đọc
2K
tranhungdao12a3
T
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2 3
Trả lời
45
Đọc
14K
ngocthu90
ngocthu90
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom