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

dephetnoi · 16/8/18

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 à

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?

Quang_Hải · 16/8/18

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!

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

hongphuong1997 · 16/8/18

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

Cảm ơn anh
Nó là như này anh à!

Quang_Hải · 16/8/18

hongphuong1997 đã viết:
Cảm ơn anh
Nó là như này anh à!

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

hongphuong1997 · 16/8/18

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

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 à.

truongvu317 · 16/8/18

hongphuong1997 đã viết:
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 à.

Thấy đúng rồi mà. Test code kỹ vào cưng ơi.

hongphuong1997 · 16/8/18

truongvu317 đã viết:
Thấy đúng rồi mà. Test code kỹ vào cưng ơi.

Chưa kéo được cột "K" và cột "G" xuống anh à.

HieuCD · 17/8/18

hongphuong1997 đã viết:
Cảm ơn anh
Nó là như này anh à!

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

Thong Hoang Tien 250691 · 17/8/18

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

HieuCD · 17/8/18

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

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

Thong Hoang Tien 250691 · 17/8/18

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

Cũng khá là tinh tế đó anh

Em cám ơn

truongvu317 · 17/8/18

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

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

HieuCD · 17/8/18

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

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à

Quang_Hải · 17/8/18

hongphuong1997 đã viết:
Chưa kéo được cột "K" và cột "G" xuống anh à.

Xem kỹ lại thì rõ ràng code của bài 44 sai tè le rồi. Hix. Đọc đề bài không cẩn thận.

Thong Hoang Tien 250691 · 17/8/18

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

Đó 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...

be_09 · 17/8/18

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.

Thong Hoang Tien 250691 · 17/8/18

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.

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.

hongphuong1997 · 17/8/18

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

Đượ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é.

Thong Hoang Tien 250691 · 17/8/18

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é.

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ộ

hongphuong1997 · 17/8/18

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

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: 17/8/18

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ộ

Vâng em quên! Cảm ơn tất cả các bác và anh chị đã giúp đỡ em nhé!

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

Thành viên chính thức

Thành viên gạo cội

Thành viên tiêu biểu

File đính kèm

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên tích cực

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

Thành viên tích cực

Chuyên gia GPE

Thành viên gạo cội

Thành viên hoạt động

Biên Hòa, Đồng Nai

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên tiêu biểu

Đếm ngược thời gian