Cần giúp đỡ thu gọn VBA

Liên hệ QC
H

hiv174

Thành viên chính thức
Tham gia
12/7/17
Bài viết
89
Được thích
13
Giới tính
Nam
em không có kiến thức về VBA và chỉ làm theo cóp nhặt nên mong mọi người giúp đỡ chỉnh sửa hoặc làm lại giúp ạ.
file mô tả phần nào em đính kèm bên dưới mong ai có chuyên môn có thể giúp em, em xin chân thành cảm ơn.
Mong mọi người có thể giúp em ( vì không có kiến thức nên có thể trong câu nói của em chưa rõ nghĩa mong mọi người thông cảm đưa ra ý kiến để em bổ xung ạ)
1: vì số dòng không cố định nên hết 1 chu kỳ dữ liệu sẽ tự xuống dòng nhưng không ghi đè lên dư liệu vừa tạo.
2: có thể tùy biến chọn vùng dư liệu ( 2 hoặc 3 hoặc 4 cột và n dòng 1 chu kỳ)
vd: chọn 2 cột thì hết 1 chu kỳ dữ liệu mới sẽ xuống dòng và bắt đầu tạo dư liệu từ dòng thứ 3 của sheet mới, chọn 3 cột thì bắt đầu từ dòng thứ 4.
3: có thể tùy biến số cột mỗi chu kỳ( trong file của em đang để là 90)
Em xin chân thành cảm ơn và mong nhận được sự giúp đỡ.
 

File đính kèm

  • tao du lieu ghep.xls
    1.1 MB · Đọc: 24
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Chu kỳ dữ liệu là cái gì, nó là cột nào?????
Cột B chỉ có 1 loại.
Cột C là số thứ tự ngược lại của cột A.
Không có tiêu đề và lại giải thích không rõ nên chẳng ai hiểu được.
 
Upvote 0
Đầu tiên em xin cám ơn nhận xét của bác, chính vì không biết gì nên em chưa biết giải thích thế nào ạ.
1 chu kỳ mà em nêu là 1 lần copy dữ liệu (dạng text) từ sheet "data" theo dòng sang sheet "ok" theo cột mà cụ thể ở đây là sheet "data" từ ("A1:A90") và ("B1:B90") sang sheet "ok" từ("A1:BH1") và ("A2:BH2") hay còn gọi là copy chuyển hàng thành cột. dư liệu có khi là cả 2 cột có khi cả 3 cột và là dạng text. nhưng đi liền với nhau khi copy.
2 vì là dạng text nên bác không phải xem chi tiết đâu ạ (không có công thức hay link dư liệu nào ạ) em làm dữ liệu để xem code thực hiện ra sao nhưng theo em serch thì được biết code chỉ lưu được 640k nên khi bác chạy sẽ thấy nó chỉ copy được 200 lần. nêu chỉ copy vùng cột A và B thì dư liệu mới sẽ có 400 dòng và 90 cột.
3 khi bác xem code thì sẽ thấy code được lặp đi lặp lại chỉ khác vùng được chọn để copy( 90 dòng tiếp theo) và vùng paste là sheet"ok"(dòng tiếp theo không có dữ liệu, a1,a3,a5,a7.....)
một lần nữa em xin chân thành cám ơn nhận xét của bác
 
Upvote 0
Bạn thử vài lần với macro sau:
PHP: 
Sub ChuyenDuLieu()
 Dim Arr()
 Dim I As Long, J As Long, Rws As Long
 
 Sheets("ok").[B2].CurrentRegion.ClearContents
 Rws = Sheets("ok").Rows.Count
 Sheets("data").Select
 J = [b1].CurrentRegion.Rows.Count
 For I = 1 To J Step 255  '*'
    Arr() = Cells(I, 1).Resize(255, 2).Value   '*'
'    If I < 999 Then MsgBox I, , Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Row '
    Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Resize(2, 255).Value = Application.WorksheetFunction.Transpose(Arr())  '*'
 Next I
 Application.ScreenUpdating = True
 End Sub
Sau đó bạn có thể nghiên cứu để tùy biến các tham số 2 & 255 trong macro
 
Upvote 0
Xin chân thành cám ơn code bạn Hoang2013 phải nói là chuẩn luôn bạn ah. bạn có thể chỉ giúp mình cách để thay đổi 2&255 bằng options điền ngay ngoài mà không cần vào code để thay đổi được không ? như thế ai cũng có thể dùng được.
 
Upvote 0
hiv174 đã viết:
Có thể chỉ giúp mình cách để thay đổi 2&255 bằng options điền ngay ngoài mà không cần vào code để thay đổi được không ?
Nhấp chuột vào đây để mở rộng...
Cái này bạn có thể lấy giá trị số 2 và 255 trên một ô nào đó trên sheet hoặc khi chạy code bạn nhập vào.
 
Upvote 0
hiv174 đã viết:
Xin chân thành cám ơn code bạn Hoang2013 phải nói là chuẩn luôn bạn ah. bạn có thể chỉ giúp mình cách để thay đổi 2&255 bằng options điền ngay ngoài mà không cần vào code để thay đổi được không ? như thế ai cũng có thể dùng được.
Nhấp chuột vào đây để mở rộng...

"ai" bao gồm từ ngừoi mới biết mở file và người lão luyện mọi thứ. Người không biết mở cửa sổ VBE ra để chay thì phải cho ngừoi ta một cái gì đó, phím tắt chẳng hạn, thì mới dùng được.
Bạn phải cho biết "dùng" bằng cách nào.
 
Upvote 0
^^ thank bác VetMini và bác giaiphap đã góp ý. Mong muốn của em là tạo bảng options ngay trên excel hay phím tắt gọi bảng đó lên để mình có thể điền giá trị ạ.
VD: muốn chọn 3 cột, n dòng thay vì 255 để làm việc thì thay vì phải vào code để thay đổi mình có thể chọn ngay ngoài bảng để người ít biết cũng có thể thao tác được ạ
 
Upvote 0
hiv174 đã viết:
^^ thank bác VetMini và bác giaiphap đã góp ý. Mong muốn của em là tạo bảng options ngay trên excel hay phím tắt gọi bảng đó lên để mình có thể điền giá trị ạ.
VD: muốn chọn 3 cột, n dòng thay vì 255 để làm việc thì thay vì phải vào code để thay đổi mình có thể chọn ngay ngoài bảng để người ít biết cũng có thể thao tác được ạ
Nhấp chuột vào đây để mở rộng...
Muốn vậy thì thay vì ghi tham số trực tiếp, ta thay bằng tham số được truyền vào từ bên ngoài, nghiên cứu truyền tham số trong sub xem sao?
đại khái như thế này, mượn code của bạn Hoang2013, code này chỉ đại khái thôi nha bạn
Mã: 
Sub ChuyenDuLieu(dong as long,cot as long)
 Dim Arr()
 Dim I As Long, J As Long, Rws As Long
 
 Sheets("ok").[B2].CurrentRegion.ClearContents
 Rws = Sheets("ok").Rows.Count
 Sheets("data").Select
 J = [b1].CurrentRegion.Rows.Count
 For I = 1 To J Step dong'*'
    Arr() = Cells(I, 1).Resize(dong, cot).Value   '*'
'    If I < 999 Then MsgBox I, , Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Row '
    Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Resize(cot,dong).Value = Application.WorksheetFunction.Transpose(Arr())  '*'
 Next I
 Application.ScreenUpdating = True
 End Sub
 
Upvote 0
dạ cám ơn bác phihndhsp em đang xem những gì bác đề cập nhưng như đã nói "em không có kiến thức về VBA" có lẽ sẽ mất thêm kha khá thời gian để có thể hiểu và làm được gợi ý của bác hix.
 
Upvote 0
Hoang2013 đã viết:
Bạn thử vài lần với macro sau:
PHP: 
Sub ChuyenDuLieu()
 Dim Arr()
 Dim I As Long, J As Long, Rws As Long
 
 Sheets("ok").[B2].CurrentRegion.ClearContents
 Rws = Sheets("ok").Rows.Count
 Sheets("data").Select
 J = [b1].CurrentRegion.Rows.Count
 For I = 1 To J Step 255  '*'
    Arr() = Cells(I, 1).Resize(255, 2).Value   '*'
'    If I < 999 Then MsgBox I, , Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Row '
    Sheets("ok").Cells(Rws, "A").End(xlUp).Offset(1).Resize(2, 255).Value = Application.WorksheetFunction.Transpose(Arr())  '*'
 Next I
 Application.ScreenUpdating = True
 End Sub
Sau đó bạn có thể nghiên cứu để tùy biến các tham số 2 & 255 trong macro
Nhấp chuột vào đây để mở rộng...
Với code của bác Hoang2013 bác nào có thể giúp em chỉnh sửa lại một chút thay vì copy thành 2 dòng thì copy 90 dòng A và B thành 1 dòng có 180 số(A1,B1,...A90,B90). Dữ liệu chạy hết 180 cột sẽ xuống dòng chạy tiếp cho đến hết ạ. Em đã thử thay các tham số 2 và 255 nhưng vẫn không được nên mong được giúp đỡ ạ. xin chân thành cám ơn!
 
Upvote 0
mong nhận được góp ý hoặc giúp đỡ ạ
 
Upvote 0
hiv174 đã viết:
mong nhận được góp ý hoặc giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
Làm mãi mới đọc lại bài 12. Nhân tiện mình đưa 2 phương án bạn xem thử (Bạn thích bao nhiêu dòng thi nhập vào hộp thoại InputBox)
Code tạo dữ liệu dạng 2 hàng
Mã: 
Sub Taodulieu2hang()
    Dim sArr, dArr, I As Long, J As Long, K As Long, N As Long
    Dim Ecol As Long, Er As Long
    N = InputBox("Nhap so cot can tao", "Nhap lieu")
    With Sheets("Data")
        sArr = .Range("A1", .Range("B65535").End(3)).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To N)
    K = 1
    For I = 1 To UBound(sArr)
        If J = N Then
            J = 1: K = K + 2
        Else
            J = J + 1
        End If
        dArr(K, J) = sArr(I, 1)
        dArr(K + 1, J) = sArr(I, 2)
    Next I
    With Sheets("ok")
        Er = .Range("A65535").End(3).Row
        Ecol = .Range("IV1").End(1).Column
        .Range("A1:A" & Er).Resize(, Ecol).ClearContents
        .Range("A1").Resize(K, N) = dArr
    End With
End Sub
Code tạo dữ liệu dạng 2 cột
Mã: 
Sub Taodulieu2cot()
    Dim sArr, dArr, I As Long, J As Long, K As Long, N As Long
    Dim Ecol As Long, Er As Long
    N = InputBox("Nhap so hang can tao", "Nhap lieu")
    With Sheets("Data")
        sArr = .Range("A1", .Range("B65535").End(3)).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To N * 2 + 1)
    K = 1
    For I = 1 To UBound(sArr)
        If J = 2 * N Then
            J = 1: K = K + 1
        Else
            J = J + 1
        End If
        dArr(K, J) = sArr(I, 1)
        J = J + 1
        dArr(K, J) = sArr(I, 2)
    Next I
    With Sheets("ok")
        Er = .Range("A65535").End(3).Row
        Ecol = .Range("IV1").End(1).Column
        .Range("A1:A" & Er).Resize(, Ecol).ClearContents
        .Range("A1").Resize(K, 2 * N) = dArr
    End With
End Sub
 
Upvote 0
nhanh, gọn dễ hiểu & quan trọng là chuẩn không cần chỉnh. Chân thành cảm ơn anh em diễn đàn, Hoang2013, giaiphap,
phihndhsp, và đặc biệt bác PacificPR đã giúp đỡ hoàn thành code này.
 
Upvote 0
Cám ơn anh befaint Em quên mất chưa bẫy lỗi :D
Bạm thử lại Code mới này xem nó tổng quát hơn
Mã: 
Sub TaodulieuNcot()
    Dim Ws As Worksheet, sRng As Range, eRing As Range, sArr, dArr, I As Long, J As Long, K As Long, N As Long, Col As Long
    Dim Ecol As Long, Er As Long
    On Error GoTo Thoat
    Set Ws = ActiveSheet
    Set sRng = Application.InputBox(Prompt:="chon vung du lieu ", Title:="Chon du lieu dau vao", Type:=8)
    N = InputBox("Nhap so hang can tao", "Nhap lieu")
    K = 1
    sArr = sRng.Value
    If N * UBound(sArr, 2) > Ws.Columns.Count Then
        MsgBox "So cot can tao lon hon so cot cua bang tinh"
        Exit Sub
    End If
    ReDim dArr(1 To UBound(sArr), 1 To N * UBound(sArr, 2))
    For I = 1 To UBound(sArr)
        If Col = UBound(sArr, 2) * N Then
            Col = 0:  K = K + 1
        End If
        For J = 1 To UBound(sArr, 2)
            Col = Col + 1
            dArr(K, Col) = sArr(I, J)
        Next J
    Next I
    Set eRng = Application.InputBox(Prompt:="chon o chua du lieu ", Title:="Chon 1 o chua du lieu", Type:=8)
    eRng.CurrentRegion.ClearContents
    eRng.Resize(K, UBound(sArr, 2) * N) = dArr
    Application.ScreenUpdating = True
Thoat:
End Sub
 
Upvote 0
befaint đã viết:
@PacificPR
Bài #14 chưa bẫy lỗi. Thử F5 rồi ESC xem...
Nhấp chuột vào đây để mở rộng...

Trời, loại bài này mà cũng bẫy lỗi? Chạy khong vừa ý thì cứ chạy lại chứ chết chóc ai.
Nếu là toi thì code loại này, thì code của tôi đầu tiên hết copy sheet để đó. Chạy xong, khi người dùng hài lòng thì xóa copy, không hài lòng thì rệt tò sheet. Cái mững nhập thông số qua inputbox thì nhầm là chiện thường.
 
Upvote 0
VetMini đã viết:
Trời, loại bài này mà cũng bẫy lỗi? Chạy khong vừa ý thì cứ chạy lại chứ chết chóc ai.
Nếu là toi thì code loại này, thì code của tôi đầu tiên hết copy sheet để đó. Chạy xong, khi người dùng hài lòng thì xóa copy, không hài lòng thì rệt tò sheet. Cái mững nhập thông số qua inputbox thì nhầm là chiện thường.
Nhấp chuột vào đây để mở rộng...
Ý em là bẫy lỗi cho Inputbox(), trường hợp có và không nhập thông số vào.
 
Upvote 0
Sau vài ngày test em thấy code chạy rất ok. Code chưa bẫy dùng nhanh gọn, code sửa lại chi tiết hơn và nhiều option hơn , thank các mem diễn đàn đã giúp đỡ và góp ý.
 
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

C
Xin công thức xếp loại có điều kiện.
Trả lời
2
Đọc
40
VetMini
V
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
12
Đọc
445
ptm0412
ptm0412
hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
28
Đọc
534
ptm0412
ptm0412
T
  • Đã khóa
Tìm một bạn có kinh nghiệm về Excel
Trả lời
0
Đọc
52
tinhnhi1202
T
H
  • Question
Code VBA cộng tổng trên bảng CĐKT
Trả lời
4
Đọc
114
vak1590
vak1590
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom