Lấy dữ liệu xuống dòng cuối (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
hongphuong1997

hongphuong1997

Thành viên tiêu biểu
Tham gia
12/11/17
Bài viết
773
Được thích
323
Giới tính
Nữ
Nhờ anh chị giúp bài như file đính kèm
Em xin cảm ơn.
 

File đính kèm

phulien1902 đã viết:
Thử:
PHP: 
Sub abc()
    Dim LR As Long
    LR = Sheets("PTDL").Cells(Rows.Count, "B").End(xlUp).Row + 1
    With Sheets("PTDL")
        .Range("B3:L8").Copy Sheets("PTDL").Range("B" & LR)
     End With
End Sub
Nhấp chuột vào đây để mở rộng...
Có nhiều khi cũng chưa đúng ý chủ Topic, xem lại dữ liệu dòng 5 với dòng 14 (bài 1) dữ liệu là khác nhau.
Cái vụ này có thể chủ Topic đưa ra ví dụ sai.
 
be09 đã viết:
Có nhiều khi cũng chưa đúng ý chủ Topic, xem lại dữ liệu dòng 5 với dòng 14 (bài 1) dữ liệu là khác nhau.
Cái vụ này có thể chủ Topic đưa ra ví dụ sai.
Nhấp chuột vào đây để mở rộng...
Bác à, chủ Topic yêu cầu đưa dữ liệu bảng 1 xuống dòng cuối bảng 2. Đâu phải lấy kết quả giống bảng 2 đâu bác?
 
phulien1902 đã viết:
Thử:
PHP: 
Sub abc()
    Dim LR As Long
    LR = Sheets("PTDL").Cells(Rows.Count, "B").End(xlUp).Row + 1
    With Sheets("PTDL")
        .Range("B3:L8").Copy Sheets("PTDL").Range("B" & LR)
     End With
End Sub
Nhấp chuột vào đây để mở rộng...
ơ không phải anh ơi (Không biết có phải là anh không mọi người sui em như vậy)
Lấy dữ liệu xuống dòng cuối cùng như bảng 2 cơ mà anh.
Đằng này anh lại lấy giữ liệu của bảng 2 về vị trí cũ rồi.
Anh xem lại giúp em với anh
phulien1902
Bài đã được tự động gộp:

be09 đã viết:
Thì tôi có nêu rồi:
Cái vụ này có thể chủ Topic đưa ra ví dụ sai.
Nhấp chuột vào đây để mở rộng...
Cháu không sai đâu bác @be09 có anh @phulien1902 đang làm lệch đề bác oy
Bài đã được tự động gộp:

phulien1902 đã viết:
Thử:
PHP: 
Sub abc()
    Dim LR As Long
    LR = Sheets("PTDL").Cells(Rows.Count, "B").End(xlUp).Row + 1
    With Sheets("PTDL")
        .Range("B3:L8").Copy Sheets("PTDL").Range("B" & LR)
     End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em sửa lại như này cho anh dễ hiểu anh
phulien1902
 

File đính kèm

Lần chỉnh sửa cuối:
hongphuong1997 đã viết:
ơ không phải anh ơi (Không biết có phải là anh không mọi người sui em như vậy)
Lấy dữ liệu xuống dòng cuối cùng như bảng 2 cơ mà anh.
Đằng này anh lại lấy giữ liệu của bảng 2 về vị trí cũ rồi.
Anh xem lại giúp em với anh
phulien1902
Bài đã được tự động gộp:


Cháu không sai đâu bác @be09 có anh @phulien1902 đang làm lệch đề bác oy
Bài đã được tự động gộp:


Em sửa lại như này cho anh dễ hiểu anh
phulien1902
Nhấp chuột vào đây để mở rộng...
Đơn giản mà:
PHP: 
Sub abc2()
    Dim LR As Long
    LR = Sheets("PTDL").Cells(Rows.Count, "B").End(xlUp).Row + 4
    With Sheets("PTDL")
        .Range("B3:F8").Copy Sheets("PTDL").Range("B" & LR)
        .Range("H3:J8").Copy Sheets("PTDL").Range("H" & LR)
        .Range("G3:G8").Copy Sheets("PTDL").Range("G" & LR + 1)
        .Range("K3:K8").Copy Sheets("PTDL").Range("K" & LR + 2)
    End With
End Sub
 
phulien1902 đã viết:
Đơn giản mà:
PHP: 
Sub abc2()
    Dim LR As Long
    LR = Sheets("PTDL").Cells(Rows.Count, "B").End(xlUp).Row + 4
    With Sheets("PTDL")
        .Range("B3:F8").Copy Sheets("PTDL").Range("B" & LR)
        .Range("H3:J8").Copy Sheets("PTDL").Range("H" & LR)
        .Range("G3:G8").Copy Sheets("PTDL").Range("G" & LR + 1)
        .Range("K3:K8").Copy Sheets("PTDL").Range("K" & LR + 2)
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh, làm như này thì thủ công quá anh ơi, anh thử nghĩ xem có cách khác không anh?
 
Bài này dễ không mà, cứ dùng vba kiểu gì chả ra, mà sao không dùng chuột với bàn phím cho nhanh. Dùng tính năng chèn cột xem có được hơm.
 
LamNA đã viết:
Anh không biết em làm báo cáo hình dáng nó sẽ ra sao nhưng trong 147 bài viết của em ít nhiều anh thấy nhiều cái VBA em cần rất lạ. :)
Nhấp chuột vào đây để mở rộng...
Cái lạ như vậy thì mới quan trọng anh à
Kiểu dữ liệu cần phải như vậy để phục vụ cho mục đích khác
 
LamNA đã viết:
Anh không biết em làm báo cáo hình dáng nó sẽ ra sao nhưng trong 147 bài viết của em ít nhiều anh thấy nhiều cái VBA em cần rất lạ. :)
Nhấp chuột vào đây để mở rộng...
Đăng thớt chủ yếu là giao lưu thả thính. Chứ cứ vba hoài nhức mắt lắm, hãy coi mõi thớt như một trò chơi, nó sẽ nhẹ nhàng cực.
 
befaint đã viết:
Để ý 10 cái chủ đề của chủ thớt/ chủ mẹt thấy rất ngộ nghĩnh, dễ thương như chủ thớt vậy. /-*+//-*+/

Mỗi chủ đề giống như một tập phim Tom & Jerry. -\\/.-\\/.
Nhấp chuột vào đây để mở rộng...
Như vậy mà bác cũng không giải được???
hi hi........
Cháu mà biết viết code thì í tưởng của cháu như này:
Tìm dòng cuối có dữ liệu của cột đầu tiên trong bảng sau đó dùng vòng lặp qua các cột khác và dán nó xuống bảng 2 thế là xong thui.
Cháu dùng công thức thì được mỗi 1 dòng cuối cùng bác à.
Bài đã được tự động gộp:

truongvu317 đã viết:
Đăng thớt chủ yếu là giao lưu thả thính. Chứ cứ vba hoài nhức mắt lắm, hãy coi mõi thớt như một trò chơi, nó sẽ nhẹ nhàng cực.
Nhấp chuột vào đây để mở rộng...
Anh hứa viết cho em mà chảng thấy đâu cả anh
truongvu317
 
Hị hị, tớ phải đi lo chyện trằng sao của mình. Bộ vba giúp tớ kiếm được ny chắc? Múc luôn.
 
Mà cái thớt này ít code thì phải, cách làm thì mình nói rồi đó.
Bài đã được tự động gộp:

hongphuong1997 đã viết:
Cái anh này toàn đi chọc ngang người khác nhé
Anh toàn đi khiêu khích phá đám người khác
Không giúp ai được việc gì?
Nhấp chuột vào đây để mở rộng...
Nhớ là chưa bao giờ phá ai thid phải. Chỉ là "tui là người yéu chinh chiến dài lâu nên mộng vba tôi nghe đã chìm sâu."
 
Bài này mà không ai làm ra kết quả bác
SA_DQ
ơi giúp cháu với
 

File đính kèm

hongphuong1997 đã viết:
Buồn quá, bài này tưởng là dễ hoa ra lại là rất khó, không có đáp án rồi...hu hu........
Nhấp chuột vào đây để mở rộng...
Phải tự hỏi lòng tại ăn ở thế nào và cần phải giải thích cái ví dụ cụ thể cái cần, bài 1 giải thích thì mù mờ còn đưa ra ví chẳng ai hiểu thì giúp cái gì bây giờ?
Bài 3 tôi thấy và nêu rất rõ "xem lại dữ liệu dòng 5 với dòng 14 (bài 1) dữ liệu là khác nhau". Người ta không hiểu lý do tại sao nó khác nhau?
 
Lần chỉnh sửa cuối:
hongphuong1997 đã viết:
Buồn quá, bài này tưởng là dễ hoa ra lại là rất khó, không có đáp án rồi...hu hu........
Nhấp chuột vào đây để mở rộng...
Chắc tại câu hỏi của em khó hiểu quá thôi, kéo là copy hay cut rồi paste. Dữ liệu các cột có ô trống không? Nếu dữ liệu bảng 1 cột B không có ô trống thì có thể dùng lệnh
Dim r as range
Set r=range("B3:L" & range("B2").end(xldown).row)
R.copy cells(18-r.rows.count,2)
Nếu tất cả các cột đều có ô trống thì xác định dòng cuối bảng 1 bằng cách tìm max row của các ô B10 đến L10.end(xlup).row rồi làm như tương tự trên.
 
be09 đã viết:
Phải tự hỏi lòng tại ăn ở thế nào và cần phải giải thích cái ví dụ cụ thể cái cần, bài 1 giải thích thì mù mờ còn đưa ra ví chẳng ai hiểu thì giúp cái gì bây giờ?
Bài 3 tôi thấy và nêu rất rõ "xem lại dữ liệu dòng 5 với dòng 14 (bài 1) dữ liệu là khác nhau". Người ta không hiểu lý do tại sao nó khác sao?
Nhấp chuột vào đây để mở rộng...
Bác xemlại cháu diễn giải như này bác nhé
Bài đã được tự động gộp:

Hau151978 đã viết:
Chắc tại câu hỏi của em khó hiểu quá thôi, kéo là copy hay cut rồi paste. Dữ liệu các cột có ô trống không? Nếu dữ liệu bảng 1 cột B không có ô trống thì có thể dùng lệnh
Dim r as range
Set r=range("B3:L" & range("B2").end(xldown).row)
R.copy cells(18-r.rows.count,2)
Nếu tất cả các cột đều có ô trống thì xác định dòng cuối bảng 1 bằng cách tìm max row của các ô B10 đến L10.end(xlup).row rồi làm như tương tự trên.
Nhấp chuột vào đây để mở rộng...
Anh xem lại file giúp em anh nhé>
Các cột sẽ có các ô trống ở bên dưới
 

File đính kèm

hongphuong1997 đã viết:
Bác xemlại cháu diễn giải như này bác nhé
Anh xem lại file giúp em anh nhé>
Các cột sẽ có các ô trống ở bên dưới
Nhấp chuột vào đây để mở rộng...
Bạn diễn đạt khó hiểu nên mọi người không hiểu để giúp bạn được.
Nếu mình hiểu đúng thì ý bạn đang muốn như trong file đính kèm.
P/S: Mình dân xài hàm, không rành vba.
 

File đính kèm

congnt92 đã viết:
Bạn diễn đạt khó hiểu nên mọi người không hiểu để giúp bạn được.
Nếu mình hiểu đúng thì ý bạn đang muốn như trong file đính kèm.
P/S: Mình dân xài hàm, không rành vba.
Nhấp chuột vào đây để mở rộng...
Vâng đúng rồi anh à, Cảm ơn anh!
Không viết đươch VBA hở anh?
 
hongphuong1997 đã viết:
Vâng đúng rồi anh à, Cảm ơn anh!
Không viết đươch VBA hở anh?
Nhấp chuột vào đây để mở rộng...
Chờ có người rành vba sẽ nhìn hàm để hiểu bạn đang muốn gì và viết cho bạn. Mình chỉ biết record thôi.
Mình gửi lại cách diễn đạt theo ý muốn của bạn để mọi người giúp đỡ viết code vba.
 

File đính kèm

congnt92 đã viết:
Chờ có người rành vba sẽ nhìn hàm để hiểu bạn đang muốn gì và viết cho bạn. Mình chỉ biết record thôi.
Mình gửi lại cách diễn đạt theo ý muốn của bạn để mọi người giúp đỡ viết code vba.
Nhấp chuột vào đây để mở rộng...
Vâng em cảm ơn anh, Chắc là sẽ có các anh chị viết code giúp anh à.
Chúc anh vạn sự thành công anh nhé!
 
Em đã ghi macro như này, nhưng không biết làm vòng lặp như nào, nhờ các anh giúp đỡ
 

File đính kèm

hongphuong1997 đã viết:
Em đã ghi macro như này, nhưng không biết làm vòng lặp như nào, nhờ các anh giúp đỡ
Nhấp chuột vào đây để mở rộng...
Chủ thớt năn nỉ quá mà sao không thấy ai viết code hết vậy ta. Bài này cũng khó nhưng cũng có thể viết được
Bạn thử code này coi đúng không nhé
Mã: 
Sub Keo_Du_Lieu()
Dim sArr(), i As Long, j As Long, ii As Long
sArr = Sheets("PTDL").Range("B3:L8").Value
For j = 1 To UBound(sArr, 2)
   For i = UBound(sArr) To 1 Step -1
      If sArr(i, j) = Empty Then
         For ii = i To 1 Step -1
            If sArr(ii, j) <> Empty Then
               sArr(i, j) = sArr(ii, j)
               sArr(ii, j) = Empty
               Exit For
            End If
         Next
      End If
   Next
Next
Sheets("PTDL").[B12].Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End Sub

PS: Đọc bài 20 của chủ thớt thì mình dự đoán đây là một siêu cao thủ code tiềm năng.
 
Lần chỉnh sửa cuối:
quanghai1969 đã viết:
Chủ thớt năn nỉ quá mà sao không thấy ai viết code hết vậy ta. Bài này cũng khó nhưng cũng có thể viết được
Bạn thử code này coi đúng không nhé
Mã: 
Sub Keo_Du_Lieu()
Dim sArr(), i As Long, j As Long, ii As Long
sArr = Sheets("PTDL").Range("B3:L8").Value
For j = 1 To UBound(sArr, 2)
   For i = UBound(sArr) To 1 Step -1
      If sArr(i, j) = Empty Then
         For ii = i To 1 Step -1
            If sArr(ii, j) <> Empty Then
               sArr(i, j) = sArr(ii, j)
               sArr(ii, j) = Empty
               Exit For
            End If
         Next
      End If
   Next
Next
Sheets("PTDL").[B12].Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End Sub

PS: Đọc bài 20 của chủ thớt thì mình dự đoán đây là một siêu cao thủ code tiềm năng.
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh
quanghai1969

! Sắp được rồi anh à
Anh sửa thêm giúp em là vẫn giữ nguyên khoảng trống giữa các ô như file đính kèm anh nhé (Em tô màu vàng)!
 

File đính kèm

quanghai1969 đã viết:
Dữ liệu mẫu có gì đó không ổn. Vì nếu đúng như vậy thì chỉ cần copy paste là xong rồi, viết code mần chi chứ
Nhấp chuột vào đây để mở rộng...
Anh ơi bởi vì không có ai viết cho em nên em thay đổi khoảng trống để dễ viết, thật ra thì nó không phải là dãy ô liên tục anh à
Anh tìm cách sửa lại code cho em với anh nhé
Cảm ơn anh!
 
hongphuong1997 đã viết:
Anh ơi bởi vì không có ai viết cho em nên em thay đổi khoảng trống để dễ viết, thật ra thì nó không phải là dãy ô liên tục anh à
Anh tìm cách sửa lại code cho em với anh nhé
Cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Có phải ý của bạn là khi nhập dữ liệu ở bảng 1 thì nó cũng sẽ tự động copy xuống bảng 2 không bạn?
 
dephetnoi đã viết:
Có phải ý của bạn là khi nhập dữ liệu ở bảng 1 thì nó cũng sẽ tự động copy xuống bảng 2 không bạn?
Nhấp chuột vào đây để mở rộng...
không phải như vậy bạn à.
Ý của mình là bảng 1 đã có sắn rồi
Nhưng bây giờ là lấy dòng cuối của các cột trên bảng 1 copy xuống cho nó bằng nhau bạn à
 
hongphuong1997 đã viết:
không phải như vậy bạn à.
Ý của mình là bảng 1 đã có sắn rồi
Nhưng bây giờ là lấy dòng cuối của các cột trên bảng 1 copy xuống cho nó bằng nhau bạn à
Nhấp chuột vào đây để mở rộng...
Là sao? Nếu có dữ liệu rồi, bạn chỉ cần copy xuống cả cụm là xong, sao lại phải thế nhỉ? Hay ý bạn là bảng 1 của bạn có nhiều dòng và giờ phải xác định dòng cuối cùng của bảng 1 và lấy dòng đó copy xuống dòng cuối cùng bảng 2?
 
hongphuong1997 đã viết:
Anh ơi bởi vì không có ai viết cho em nên em thay đổi khoảng trống để dễ viết, thật ra thì nó không phải là dãy ô liên tục anh à
Anh tìm cách sửa lại code cho em với anh nhé
Cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Bạn nên cung cấp dữ liệu thật để mọi người nghiên cứu thử. Chứ dữ liệu tạm kiểu này khó ra đúng ý lắm à. vì dữ liệu của bài 36 thì không cần code két gì cả. chỉ copy paste 1 cái là xong
 
quanghai1969 đã viết:
Bạn nên cung cấp dữ liệu thật để mọi người nghiên cứu thử. Chứ dữ liệu tạm kiểu này khó ra đúng ý lắm à. vì dữ liệu của bài 36 thì không cần code két gì cả. chỉ copy paste 1 cái là xong
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh
Nó là như này anh à!
 

File đính kèm

hongphuong1997 đã viết:
Cảm ơn anh
Nó là như này anh à!
Nhấp chuột vào đây để mở rộng...
Hên thì trúng ý hén. Những dạng bài thế này dễ bỏ chạy lắm à

Mã: 
Sub Keo_Du_Lieu()
Dim sArr(), i As Long, j As Long, ii As Long, dArr()
sArr = Sheets("PTDL").Range("B3:L8").Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
   For i = 1 To UBound(sArr)
      If sArr(i, 1) <> Empty Then
         ii = ii + 1
         For j = 1 To UBound(sArr, 2)
            dArr(i, j) = sArr(i, j)
         Next
      End If
   Next

Sheets("PTDL").[B12].Offset(ii).Resize(UBound(dArr) - ii, UBound(dArr, 2)) = dArr
End Sub
 
quanghai1969 đã viết:
Hên thì trúng ý hén. Những dạng bài thế này dễ bỏ chạy lắm à

Mã: 
Sub Keo_Du_Lieu()
Dim sArr(), i As Long, j As Long, ii As Long, dArr()
sArr = Sheets("PTDL").Range("B3:L8").Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
   For i = 1 To UBound(sArr)
      If sArr(i, 1) <> Empty Then
         ii = ii + 1
         For j = 1 To UBound(sArr, 2)
            dArr(i, j) = sArr(i, j)
         Next
      End If
   Next

Sheets("PTDL").[B12].Offset(ii).Resize(UBound(dArr) - ii, UBound(dArr, 2)) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh
quanghai1969
vẫn chưa kéo được các dòng cuối của mảng trên xuống hết anh à.
 
hongphuong1997 đã viết:
Cảm ơn anh
Nó là như này anh à!
Nhấp chuột vào đây để mở rộng...
Không biết code kiểu này để làm gì :(
Mã: 
Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, j As Long, ik As Long, sRow As Long
  sArr = Sheets("PTDL").Range("B3:L8").Value
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To UBound(sArr, 2))
 
  For j = 1 To UBound(sArr, 2)
    ik = sRow + 1
    For i = sRow To 1 Step -1
      If Len(sArr(i, j)) Then
         For n = i To 1 Step -1
          ik = ik - 1
          Res(ik, j) = sArr(n, j)
         Next n
         Exit For
      End If
    Next i
  Next j
  Sheets("PTDL").Range("B12").Resize(sRow, UBound(Res, 2)) = Res
End Sub
 
Xin phép @Thớt và anh @HieuCD , Thấy các bạn bàn tán rôm rả tôi cũng muốn tham gia chút.
Trong file tôi dùng For - Next thay vì dùng mảng. Mong các bạn góp ý thêm.
@hongphuong1997 xem đúng ý cô chưa ?
Mã: 
Sub test1()
Dim i, j, k As Integer
Dim a, b, vLue, vCopy

For k = 2 To 12
    For i = 3 To 8
        vLue = Sheets(1).Cells(i, k)
    If vLue <> "" Then
        a = i
    End If
Next i

b = 17 - a
For j = 3 To a
    vCopy = Sheets(1).Cells(j, k)
    Sheets(1).Cells(j + b, k) = vCopy
Next j
Next k

End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Thong Hoang Tien 250691 đã viết:
Xin phép @Thớt và anh @HieuCD , Thấy các bạn bàn tán rôm rả tôi cũng muốn tham gia chút.
Trong file tôi dùng For - Next thay vì dùng mảng. Mong các bạn góp ý thêm.
@hongphuong1997 xem đúng ý cô chưa ?
Mã: 
Sub test1()
Dim i, j, k As Integer
Dim a, b, vLue, vCopy

For k = 2 To 12
    For i = 3 To 8
        vLue = Sheets(1).Cells(i, k)
    If vLue <> "" Then
        a = i
    End If
Next i

b = 17 - a
For j = 3 To a
    vCopy = Sheets(1).Cells(j, k)
    Sheets(1).Cells(j + b, k) = vCopy
Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...
Rút gon code lại
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer

For k = 2 To 12
    For i = 3 To 8
      If Sheets(1).Cells(i, k).Value <> "" Then a = i
    Next i
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k

End Sub
 
HieuCD đã viết:
Rút gon code lại
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer

For k = 2 To 12
    For i = 3 To 8
      If Sheets(1).Cells(i, k).Value <> "" Then a = i
    Next i
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...
Cũng khá là tinh tế đó anh :) Em cám ơn
 
HieuCD đã viết:
Rút gon code lại
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer

For k = 2 To 12
    For i = 3 To 8
      If Sheets(1).Cells(i, k).Value <> "" Then a = i
    Next i
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...
Chắc chắn là không thể làm đẹp lòng cbur thớt rùi. Vì dữ liệu thực tế vài nghìn dòng. Chứ vài dòng thì copy bằng tay cho nó nhanh
 
truongvu317 đã viết:
Chắc chắn là không thể làm đẹp lòng cbur thớt rùi. Vì dữ liệu thực tế vài nghìn dòng. Chứ vài dòng thì copy bằng tay cho nó nhanh
Nhấp chuột vào đây để mở rộng...
Chỉ chỉnh code cho tạm ổn hơn thôi
Thích thì làm, không làm vì ý thích người khác, người khác không thích cũng không sao. Khà khà
 
truongvu317 đã viết:
Chắc chắn là không thể làm đẹp lòng cbur thớt rùi. Vì dữ liệu thực tế vài nghìn dòng. Chứ vài dòng thì copy bằng tay cho nó nhanh
Nhấp chuột vào đây để mở rộng...
Đó là ví dụ thôi. Còn tìm được cách làm rồi thì tự chỉnh code sao cho phù hợp nhất chứ ai biết mục đích thớt muốn làm cái gì đâu mà đoán với viết...
 
Tôi nghi ngờ cái ý tưởng của chủ Topic quá, có thể là vầy:
1/ Bảng 1 chứa dữ liệu trong vùng B3: L8.
2/ Lấy Cell cuối cùng của từng cột từ cột B: L.
3/ Mỗi lần lấy dữ liệu xong thì gán tiếp theo xuống dưới.
 
be09 đã viết:
Tôi nghi ngờ cái ý tưởng của chủ Topic quá, có thể là vầy:
1/ Bảng 1 chứa dữ liệu trong vùng B3: L8.
2/ Lấy Cell cuối cùng của từng cột từ cột B: L.
3/ Mỗi lần lấy dữ liệu xong thì gán tiếp theo xuống dưới.
Nhấp chuột vào đây để mở rộng...
Em thấy trong file bạn này ghi đề khá rõ ràng rồi mà. Chỉ có điều em không rõ mục đích là gì thôi.
 
HieuCD đã viết:
Không biết code kiểu này để làm gì :(
Mã: 
Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, j As Long, ik As Long, sRow As Long
  sArr = Sheets("PTDL").Range("B3:L8").Value
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To UBound(sArr, 2))

  For j = 1 To UBound(sArr, 2)
    ik = sRow + 1
    For i = sRow To 1 Step -1
      If Len(sArr(i, j)) Then
         For n = i To 1 Step -1
          ik = ik - 1
          Res(ik, j) = sArr(n, j)
         Next n
         Exit For
      End If
    Next i
  Next j
  Sheets("PTDL").Range("B12").Resize(sRow, UBound(Res, 2)) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Được rồi bác
HieuCD
ơi, Cháu cảm ơn bác!
Bác quá cao thủ bác ơi. Cái này cháu rất cần để đưa vào 1 bảng khác bác
HieuCD
à chứ không phải là bài toán ngớ ngẩn đâu. Chúc bác vạn sự an lành bác nhé.
 
hongphuong1997 đã viết:
Được rồi bác
HieuCD
ơi, Cháu cảm ơn bác!
Bác quá cao thủ bác ơi. Cái này cháu rất cần để đưa vào 1 bảng khác bác
HieuCD
à chứ không phải là bài toán ngớ ngẩn đâu. Chúc bác vạn sự an lành bác nhé.
Nhấp chuột vào đây để mở rộng...
Cũng nhiều người trả lời vào topic mà đã mất công cám ơn thì cứ nói cám ơn tất cả mọi người có mất gì đâu. Thật khiến dân tình phẫn nộ :)
 
HieuCD đã viết:
Rút gon code lại
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer

For k = 2 To 12
    For i = 3 To 8
      If Sheets(1).Cells(i, k).Value <> "" Then a = i
    Next i
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...
Trời ơi!
Bài này cũng đúng rồi anh
Thong Hoang Tien 250691
ơi, em cảm ơn anh nhé. Chúc anh vui vẻ anh nhé
(Thế là 1 lúc có 2 đáp án đúng anh à)
Bài đã được tự động gộp:

Thong Hoang Tien 250691 đã viết:
Cũng nhiều người trả lời vào topic mà đã mất công cám ơn thì cứ nói cám ơn tất cả mọi người có mất gì đâu. Thật khiến dân tình phẫn nộ :)
Nhấp chuột vào đây để mở rộng...
Vâng em quên! Cảm ơn tất cả các bác và anh chị đã giúp đỡ em nhé!
 
Thong Hoang Tien 250691 đã viết:
Xin phép @Thớt và anh @HieuCD , Thấy các bạn bàn tán rôm rả tôi cũng muốn tham gia chút.
Trong file tôi dùng For - Next thay vì dùng mảng. Mong các bạn góp ý thêm.
@hongphuong1997 xem đúng ý cô chưa ?
Mã: 
Sub test1()
Dim i, j, k As Integer
Dim a, b, vLue, vCopy

For k = 2 To 12
    For i = 3 To 8
        vLue = Sheets(1).Cells(i, k)
    If vLue <> "" Then
        a = i
    End If
Next i

b = 17 - a
For j = 3 To a
    vCopy = Sheets(1).Cells(j, k)
    Sheets(1).Cells(j + b, k) = vCopy
Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...
Nhưng anh ơi em muốn lấy số "0" ở đầu các số thì phải làm như nào hở anh?
 
Bạn nên coi chừng chỗ nguy hiểm của code (tôi chú thích trong code):

HieuCD đã viết:
Rút gon code lại
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer

For k = 2 To 12
    For i = 3 To 8
      If Sheets(1).Cells(i, k).Value <> "" Then a = i
    Next i
' 1. Biến a không được reset lại ở đầu hoặc cuối vòng lặp k, như vậy nếu không gặp ô thoả thì nó sẽ giữ lại trị của dòng trước nó
'     Tôi khong rõ điều này có đúng ý định hay khong, nhưng nếu khong phải thì rất khó debug
' 2. Vòng lặp này tìm ô khác trống cuối cùng trong dãy
'     Như vậy, bạn có thể đếm ngược từ 8 về 3, gặp không trống thì thoát. Code như vậy đọc dễ hiểu hơn.
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k

End Sub
Nhấp chuột vào đây để mở rộng...

Chú: vòng lặp i và j hoàn toàn độc lập với nhau. Trên nguyên tắc, bạn có thể dùng lại biến i, khong cần dùng j. Vả lại một trong những điều mà lập trình nên tránh là dùng j làm chỉ số dòng.
 
VetMini đã viết:
Bạn nên coi chừng chỗ nguy hiểm của code (tôi chú thích trong code):



Chú: vòng lặp i và j hoàn toàn độc lập với nhau. Trên nguyên tắc, bạn có thể dùng lại biến i, khong cần dùng j. Vả lại một trong những điều mà lập trình nên tránh là dùng j làm chỉ số dòng.
Nhấp chuột vào đây để mở rộng...
Em cám ơn. Về biến a thì trong trường hợp này đúng là em đã quên không reset. Nó sẽ chạy sai nếu 1 cột bất kỳ không có dữ liệu (nói đúng hơn là chạy thừa, lãng phí, vì suy cho cùng nếu không có dữ liệu thì cũng không có gì để copy cả). Còn ý 2 "lập trình" cần tránh những gì em chưa rõ hết, nhưng vẫn xin ghi nhận góp ý của anh.
Bài đã được tự động gộp:

hongphuong1997 đã viết:
Nhưng anh ơi em muốn lấy số "0" ở đầu các số thì phải làm như nào hở anh?
Nhấp chuột vào đây để mở rộng...
Thì bạn ghi dạng Text của cell dữ liệu đó là được mà. Lưu ý là bảng 2 bạn cũng cần để định dạng text luôn :)
 
Lần chỉnh sửa cuối:
VetMini đã viết:
Bạn nên coi chừng chỗ nguy hiểm của code (tôi chú thích trong code):



Chú: vòng lặp i và j hoàn toàn độc lập với nhau. Trên nguyên tắc, bạn có thể dùng lại biến i, khong cần dùng j. Vả lại một trong những điều mà lập trình nên tránh là dùng j làm chỉ số dòng.
Nhấp chuột vào đây để mở rộng...
Viết code nhiều mà còn bị sơ sót khá nguy hiểm :(, cũng may chỉ gán giá trị trống nên thoát nạn:)
 
2. Vòng lặp này tìm ô khác trống cuối cùng trong dãy
' Như vậy, bạn có thể đếm ngược từ 8 về 3, gặp không trống thì thoát. Code như vậy đọc dễ hiểu hơn.
Nhấp chuột vào đây để mở rộng...
@VetMini Em cũng thử viết theo cách anh hướng dẫn, không biết em viết đúng hay không?
Mã: 
For i = 8 To 3 Step -1
    If Sheets(1).Cells(i, k).Value <> "" Then
      a = i
      Exit For
    End If
Next i
 
Lần chỉnh sửa cuối:
hongphuong1997 đã viết:
Em cảm ơn anh, code ngắn gọn quá anh.
Nhưng code không chạy được anh à
Nhấp chuột vào đây để mở rộng...
Cái này là mình theo chỉ dẫn của anh VetMiNi "Đếm từ dưới lên", mình viết tắt, hoàn chỉnh phải là :
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer
For k = 2 To 12
    For i = 8 To 3 Step -1
    If Sheets(1).Cells(i, k).Value <> "" Then
      a = i
      Exit For
    End If
Next i   
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k
End Sub
 
Thong Hoang Tien 250691 đã viết:
Cái này là mình theo chỉ dẫn của anh VetMiNi "Đếm từ dưới lên", mình viết tắt, hoàn chỉnh phải là :
Mã: 
Sub test1()
Dim i As Integer, j As Integer, k As Integer
Dim a As Integer, b As Integer
For k = 2 To 12
    For i = 8 To 3 Step -1
    If Sheets(1).Cells(i, k).Value <> "" Then
      a = i
      Exit For
    End If
Next i  
    b = 17 - a
    For j = 3 To a
        Sheets(1).Cells(j + b, k).Value = Sheets(1).Cells(j, k).Value
    Next j
Next k
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh
Chúc anh luôn luôn yêu đời và nhanh chóng lấy vợ đi anh nhé!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Y
Lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp hàng dọc (4 người xem)
Trả lời
5
Đọc
509
SA_DQ
SA_DQ
N
Hàm tính chuỗi số trong 1 ô hoặc 1 dãy ô ra tổng kết quả. (2 người xem)
Trả lời
2
Đọc
83
minhminh27
minhminh27
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
382
Đọc
45K
TomRuoi
TomRuoi
NguyenthiH
Mở file Excel có Pass Open (2 người xem)
Trả lời
39
Đọc
3K
Hoàng Tuấn 868
H
M
Tách dữ liệu trong 1 file thành nhiều sheet theo số lượng dòng (1 người xem)
    • Ngạc nhiên
Trả lời
25
Đọc
3K
Hoàng Tuấn 868
H
T
Tìm số hóa đơn trong chuỗi (1 người xem)
Trả lời
11
Đọc
417
thao nguyen01
T
T
  • Question Question
Nhờ ACE cao thủ hỗ trợ mình có một chương trình EXCEL về phân công lớp cho giáo viên (3 người xem)
Trả lời
6
Đọc
305
DeTong
D
T
Nhờ các anh chị sửa dùm công thức ạ. (1 người xem)
Trả lời
10
Đọc
199
trantrungvinh1989
T
C
Chia sẻ: Kết quả xổ số Keno (1 người xem)
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế (2 người xem)
    • Yêu thích
    • Thích
Trả lời
1
Đọc
332
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel (1 người xem)
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến
Trả lời
28
Đọc
2K
nguyendang95
N
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng (1 người xem)
Trả lời
13
Đọc
283
dazkangel
dazkangel
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
290
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
114
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính (1 người xem)
Trả lời
16
Đọc
347
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
703
nguyendang95
N
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
151
Nga1852k
Nga1852k
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom