Nhờ mọi người giúp đỡ cách copy dữ liệu qua sheet khác theo thứ tự quy ước (6 người xem)

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

Người dùng đang xem chủ đề này

FatBear

Thành viên hoạt động
Tham gia
28/1/13
Bài viết
120
Được thích
69
E có dữ liệu ở sheet "NHAP" và muốn nhờ mọi người giúp 1 code có thể copy dữ liệu từ sheet "NHAP" sang sheet "CSDL" theo thứ tự đã định sẵn
cụ thể đã được e miêu tả và ví dụ ở trong file
e cảm ơn mọi người đã đọc bài và trợ giúp ạ ^^^^
1532606315782.png
1532606326356.png
 

File đính kèm


ban tham khao attachment xem dung y ban chua ?

code nay minh viet van co nhieu cho han che, neu cao thu nao tim ra loi thi xin gop y chu dung trach minh nhe.
Mã:
Sub test1()

r = 5
c = 2
For k = 1 To 55188

For i = 1 To 8
    check = Workbooks("copy.xlsm").Sheets(2).Cells(r, c)
If check = "" Then

    For j = 5 To 19

            Workbooks("copy.xlsm").Sheets(2).Cells(r, c) = Workbooks("copy.xlsm").Sheets(1).Cells(j, 2)
            Workbooks("copy.xlsm").Sheets(2).Cells(r, c + 1) = Workbooks("copy.xlsm").Sheets(1).Cells(j, 3)
        r = r + 1
    Next j
    Exit Sub
Else
    r = r
    c = c + 3
End If
Next i
    r = r + 18
    c = 2
Next k

End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Bạn nên viết bài với tiếng Việt có dấu đầy đủ, bạn đọc lại nội quy tại khoản 1, mục II. Hình thức của bài viết, ở Link sau:
https://www.giaiphapexcel.com/diendan/threads/nội-quy-diễn-đàn-cập-nhật.76052/[/php]
thành thật xin lỗi vì sự bất tiện này, do laptop trong cơ quan bị lỗi hay font lỗi mà mình không thể sử dụng unikey như bình thường.
 
Nếu dùng Option Explicit thì sẽ phát sinh lỗi. Vì vậy, phải thêm biến sau vào.
Mã:
Dim r, c, k, i, check, j As Long
 
ban tham khao attachment xem dung y ban chua ?

code nay minh viet van co nhieu cho han che, neu cao thu nao tim ra loi thi xin gop y chu dung trach minh nhe.
Mã:
Sub test1()

r = 5
c = 2
For k = 1 To 55188

For i = 1 To 8
    check = Workbooks("copy.xlsm").Sheets(2).Cells(r, c)
If check = "" Then

    For j = 5 To 19

            Workbooks("copy.xlsm").Sheets(2).Cells(r, c) = Workbooks("copy.xlsm").Sheets(1).Cells(j, 2)
            Workbooks("copy.xlsm").Sheets(2).Cells(r, c + 1) = Workbooks("copy.xlsm").Sheets(1).Cells(j, 3)
        r = r + 1
    Next j
    Exit Sub
Else
    r = r
    c = c + 3
End If
Next i
    r = r + 18
    c = 2
Next k

End Sub
ổn rồi bác ạ. e cảm ơn bác nhiều .^^^^
mà tiện bác cho e hỏi biến k là để làm gì vậy và số 55188 là số gì vậy ạ
 
ổn rồi bác ạ. e cảm ơn bác nhiều .^^^^
mà tiện bác cho e hỏi biến k là để làm gì vậy và số 55188 là số gì vậy ạ
đó là dòng cuối cùng chia cho 19, sấp sỉ số đó.
biến k là nếu đến cột X của dòng đầu tiên vẫn còn ký tự thì nó sẽ tự động xuống dòng tiếp theo
 
Lần chỉnh sửa cuối:
đó là dòng cuối cùng chia cho 19, sấp sỉ số đó.
biến k là nếu đến cột X của dòng đầu tiên vẫn còn ký tự thì nó sẽ tự động xuống dòng tiếp theo
cho e hỏi chút là. e thấy trong code của bác viết thì nó duyệt từ dòng thứ 5 trở đi ở mỗi lần code chạy. nên e muốn hỏi bác là có cách nào cho nó duyệt từ dòng cuối ở lần ghi số liệu tiếp theo ko ạ. tức là nó sẽ duyệt ở dòng có dữ liệu cuối cùng để ghi ấy ạ. e nghĩ là như thế nó sẽ nhanh hơn khi CSDL tăng dần theo thời gian, khi dòng lên hàng trăm nghìn thì khả năng sợ code sẽ chạy chậm :D:D
1532665797255.png
 
cho e hỏi chút là. e thấy trong code của bác viết thì nó duyệt từ dòng thứ 5 trở đi ở mỗi lần code chạy. nên e muốn hỏi bác là có cách nào cho nó duyệt từ dòng cuối ở lần ghi số liệu tiếp theo ko ạ. tức là nó sẽ duyệt ở dòng có dữ liệu cuối cùng để ghi ấy ạ. e nghĩ là như thế nó sẽ nhanh hơn khi CSDL tăng dần theo thời gian, khi dòng lên hàng trăm nghìn thì khả năng sợ code sẽ chạy chậm
Bạn xem thử file này:
 

File đính kèm

cách của a rất hay nhưng nó bị phụ thuộc vào biến N ạ. nếu N bị thay đổi sẽ khiến vị trí ở lần copy tiếp theo rất dễ bị lẫn
và nó bị cái khung khung gì ấy ạ. e nhìn nó cứ thế nào ấy T_T cụ thể như dưới a ạ :(
e cảm ơn a đã trợ giúp :D
1532670634479.png
 
cách của a rất hay nhưng nó bị phụ thuộc vào biến N ạ. nếu N bị thay đổi sẽ khiến vị trí ở lần copy tiếp theo rất dễ bị lẫn
và nó bị cái khung khung gì ấy ạ. e nhìn nó cứ thế nào ấy T_T cụ thể như dưới a ạ :(
e cảm ơn a đã trợ giúp :D
View attachment 200571
Bạn tham khảo thêm cách này xem sao
PHP:
Sub Thu_ty()
    Dim Rng As Range, I As Long, R As Long, Col As Long, Ip As Long
Set Rng = Sheet1.Range("B5:C19")
With Sheet2
    R = .Range("B" & Rows.Count).End(xlUp).Row
    Col = .Cells(R, Columns.Count).End(xlToLeft).Column
    If Col = 24 Then Col = 1
    If Col = 1 Then
Handle:
        I = IIf(R < 5, 5, IIf(Col = 1, R + 4, R - Rng.Rows.Count + 1))
        With .Range("A1").Validation
            .Delete: .Add Type:=xlValidateInputOnly: .InputMessage = I
        End With
    End If
    On Error GoTo Handle
    Ip = .Range("A1").Validation.InputMessage
    If Col = 1 Then
        .Cells(Ip, Col).Offset(, 1).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
    Else
        .Cells(Ip, Col).Offset(, 2).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
    End If
End With
End Sub
Sửa lại cho dễ nhìn
 
Lần chỉnh sửa cuối:
@ Chủ thớt:
Kịch bản của chương trình:
- InputBox yêu cầu chọn vùng cần copy.
- InputBox yêu cầu chọn ô [cell] đầu tiên của vùng cần gán kết quả.
- Nhập số dãy, số cột kết quả, số kết quả cần gán, số columns trống giữa các cột kết quả, số rows trống giữa các dãy kết quả.
- Click ok. Xong.

????
 
Bạn tham khảo thêm cách này xem sao
PHP:
Sub Thu_ty()
    Dim Rng As Range, I As Long, R As Long, Col As Long, Ip As Long
Set Rng = Sheet1.Range("B5:C19")
With Sheet2
    R = .Range("B" & Rows.Count).End(xlUp).Row
    Col = .Cells(R, Columns.Count).End(xlToLeft).Column
    If Col = 1 Then
Handle:
        If R < 5 Then
            I = 5
        Else
            I = IIf(Col = 24, R + 4, R - Rng.Rows.Count + 1)
        End If
        If Col = 24 Then Col = 1
        With .Range("A1").Validation
            .Delete: .Add Type:=xlValidateInputOnly: .InputMessage = I
        End With
    End If
    On Error GoTo Handle
    Ip = .Range("A1").Validation.InputMessage
    If Col = 1 Then
        .Cells(Ip, Col).Offset(, 1).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
    Else
        .Cells(Ip, Col).Offset(, 2).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
    End If
End With
End Sub
@ Chủ thớt:
Kịch bản của chương trình:
- InputBox yêu cầu chọn vùng cần copy.
- InputBox yêu cầu chọn ô [cell] đầu tiên của vùng cần gán kết quả.
- Nhập số dãy, số cột kết quả, số kết quả cần gán, số columns trống giữa các cột kết quả, số rows trống giữa các dãy kết quả.
- Click ok. Xong.

????
e cảm ơn 2 bác đã giúp đỡ ạ.
code các bác đã đáp ứng được yêu cầu của bài toán rồi ạ.
cho e xin bổ sung thêm 1 trường hợp khác được ko ạ.
như phía trên là mình ghi số liệu từ sheet NHAP sang sheet CSDL liên tục không ngắt quãng, tức là hết dòng thứ nhất sẽ xuống dòng thứ 2
nếu như bây giờ mình ghi được nửa dòng thứ 2 rồi, mình không ghi nữa mà nhảy xuống dòng thứ 3 và lại tiếp tục ghi tiếp lần lượt thì phải chỉnh sửa như nào ạ. cụ thể như ở hình phía dưới ạ :D
e cảm ơn mọi người ^^^^
1532675484999.png
 
E cảm ơn tất cả mọi người đã trợ giúp.
e đã tìm cách xử lý được trường hợp thứ 2 rồi ạ.
^^^^^^^^
 
Web KT

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

Back
Top Bottom