Lấy dữ liệu xuống dòng cuối

Liên hệ QC
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

  • kéo dữ liệu-1.xlsx
    9.6 KB · Đọc: 12
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

  • Copy.xlsm
    19.3 KB · Đọc: 8
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é!
 
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

LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2
Trả lời
30
Đọc
323
NCSCVN
NCSCVN
L
Tạo hàm Round cho nhiều dòng
Trả lời
14
Đọc
6K
KenJayce
K
N
Giải pháp nào để gỡ bỏ hàm Round (là hàm ngoài cùng) trong tất cả các ô trong bảng?
Trả lời
8
Đọc
4K
KenJayce
K
T
Tổng hợp từ Sheet1 qua Sheet2
Trả lời
7
Đọc
115
thaiquy7
T
ann266
Kế toán kho F&B
    • Cười
2
Trả lời
22
Đọc
252
le_vis
L
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