Dùng VBA dò tìm vị trí để dán dữ liệu

Liên hệ QC

Ngayngo32

Thành viên mới
Tham gia
5/6/22
Bài viết
12
Được thích
2
Giới tính
Nữ
Mọi người ơi giúp em với ạ, em đang muốn dùng VBA tìm vị trí chữ cái xuất hiện lần đầu tiên của cột A (các chữ cái chạy theo thứ tự như cột K), sau đó copy vùng M1:N50 vào vị trí xuất hiện lần đầu tiên của chữ cái đó và xóa vùng thừa như ví dụ ạ
 

File đính kèm

  • Mẫu.xlsx
    13.3 KB · Đọc: 34
Mọi người ơi giúp em với ạ, em đang muốn dùng VBA tìm vị trí chữ cái xuất hiện lần đầu tiên của cột A (các chữ cái chạy theo thứ tự như cột K), sau đó copy vùng M1:N50 vào vị trí xuất hiện lần đầu tiên của chữ cái đó và xóa vùng thừa như ví dụ ạ
Đọc rồi mà vẫn chưa hiểu lắm. Giải thích cụ thể hơn được không?
 
Upvote 0
Đọc rồi mà vẫn chưa hiểu lắm. Giải thích cụ thể hơn được không?
Dạ em muốn được kết quả như cột B:C nhưng chưa biết viết code thế nào..anh biết giúp em với ạ em cám ơn
Bài đã được tự động gộp:

Mình vẫn nhớ bài: Chim gặp bác Chào mào, chào bác.
Chẳng lẽ con người lại không bằng con chim nhỉ.
Anh nói vậy tội em quá ạ, la do em gấp nên viết không để ý ạ, anh giúp em được em cám ơn không hết chứ ạ
 
Upvote 0
Đọc rồi mà vẫn chưa hiểu lắm. Giải thích cụ thể hơn được không?
1. Đọc M1:N50 vào một mảng mang
2. Vòng lặp theo từng Cell của cột K
2.1 Dùng Find, Match gì đó, tìm trị của Cell trong cột A
2.2 Nếu tìm được thì gán mảng mang vào cột B
2.3 Ghi nhớ ký tự vừa gán, và vị trí ký tự ấy
3. Từ vị trí đã ghi nhớ, đọc cột A cho đến khi hết ký tự đã ghi nhớ, tức là gặp ký tự khác hoặc trống. Đếm được bao nhiêu dòng (n).
4. Xóa 50-n+1 dòng ở B:C
 
Upvote 0
Vậy thì lần sau họ mới tiếp thôi vì chẳng có lý do gì cản trở bạn rút kinh nghiệm ngay từ lần này.
Dạ vậy em xin viết lại đăng lại anh vào giúp em nhé, xem như đó là lần sau:
Xin chào các anh chị, em tên là TH em mới bắt đầu học VBA , hiện có bài tập nhờ mọi người giúp em, em đang muốn dùng VBA tìm vị trí chữ cái xuất hiện lần đầu tiên của cột A (các chữ cái chạy theo thứ tự như cột K), sau đó copy vùng M1:N50 vào vị trí xuất hiện lần đầu tiên của chữ cái đó và xóa vùng thừa như ví dụ ạ. Anh chị giúp dùm em em cám ơn rất rất nhiều ạ.
 
Upvote 0
Dạ em muốn được kết quả như cột B:C nhưng chưa biết viết code thế nào..anh biết giúp em với ạ em cám ơn
Bạn thử theo giải thuật này viết code thử xem.
1. Đọc M1:N50 vào một mảng mang
2. Vòng lặp theo từng Cell của cột K
2.1 Dùng Find, Match gì đó, tìm trị của Cell trong cột A
2.2 Nếu tìm được thì gán mảng mang vào cột B
2.3 Ghi nhớ ký tự vừa gán, và vị trí ký tự ấy
3. Từ vị trí đã ghi nhớ, đọc cột A cho đến khi hết ký tự đã ghi nhớ, tức là gặp ký tự khác hoặc trống. Đếm được bao nhiêu dòng (n).
4. Xóa 50-n+1 dòng ở B:C
 
Upvote 0
Bắt đầu có những lời khuyên giúp bạn rồi đó.
Thầy bảo thầy dạy điều hay ý đẹp, thầy k dạy nếu trò k sửa, cơ mà trò sửa thì thầy bảo đi mà học người khác.....đánh người chạy đi chứ ai đánh người chạy lại thầy ạ..em cũng chỉ xin tí động lực thôi mà
 
Upvote 0
Thầy bảo thầy dạy điều hay ý đẹp, thầy k dạy nếu trò k sửa, cơ mà trò sửa thì thầy bảo đi mà học người khác.....đánh người chạy đi chứ ai đánh người chạy lại thầy ạ..em cũng chỉ xin tí động lực thôi mà
Bạn nên làm theo lời khuyên ở bài #12 đi đã, mình thấy lời khuyên đó trùng với ý tưởng của mình nên không nhắc lại nữa.
 
Upvote 0
1. Đọc M1:N50 vào một mảng mang
2. Vòng lặp theo từng Cell của cột K
2.1 Dùng Find, Match gì đó, tìm trị của Cell trong cột A
2.2 Nếu tìm được thì gán mảng mang vào cột B
2.3 Ghi nhớ ký tự vừa gán, và vị trí ký tự ấy
3. Từ vị trí đã ghi nhớ, đọc cột A cho đến khi hết ký tự đã ghi nhớ, tức là gặp ký tự khác hoặc trống. Đếm được bao nhiêu dòng (n).
4. Xóa 50-n+1 dòng ở B:C
Dạ em cám ơn ạ, anh có thể chỉ em thêm tí được không do em mới tìm hiểu VBA nên code còn chưa logic ạ
Bài đã được tự động gộp:

Bạn nên làm theo lời khuyên ở bài #12 đi đã, mình thấy lời khuyên đó trùng với ý tưởng của mình nên không nhắc lại nữa.
Dạ vậy em thầy văn chương ạ
Bài đã được tự động gộp:

Dạ em cám ơn ạ, anh có thể chỉ em thêm tí được không do em mới tìm hiểu VBA nên code còn chưa logic ạ
Bài đã được tự động gộp:


Dạ vậy em thầy văn chương ạ
cám ơn ạ
 
Upvote 0
Do bạn "mới bắt đầu học VBA" nên tôi giả thiết là bạn không biết viết code ngay cả khi có gợi ý. Vậy thì hoặc không giúp (không có thời gian, không có hứng cầy từ A đến Z) hoặc giúp từ A đến Z. Tôi từng đọc thấy người ta gọi những kẻ giúp từ A đến Z là rỗi hơi. Mỗi người đều độc lập và tự chủ trong mỗi quyết định của mình. Tôi không bắt ai phải làm từ A đến Z như mình. Và chả ai có quyền chế diễu tôi khi tôi muốn giúp từ A đến Z. Thôi kệ.

Mỗi bài Toán có nhiều cách giải. Nếu bạn đảm bảo là các chữ cái trong cột A đều xuất hiện trong cột K thì chả cần xét cột K. Nếu trong cột A do sơ suất có thể có chữ cái không có trong cột K thì phải sửa code ở dưới.

Ta sẽ xác định vị trí xuất hiện đầu tiên của mỗi chữ cái trong cột A bằng cách so sánh với chucai_hienhanh (ở thời điểm chào buổi sáng chucaihienhanh = RỖNG). Nếu khác thì đó là vị trí đầu tiên của chữ cái.

Việc của bạn chỉ có nghĩa khi các chữ cái trong cột A được sắp xếp, không cần phải tăng dần, có thể là giảm dần, miễn là được sắp xếp.
Code phục vụ cả trường hợp dữ liệu cột A có dòng trống.

Phân tích code sẽ thấy code chạy cho cả những trường hợp cột A không chứa chữ cái 1 ký tự mà chứa câu từ bất kỳ.

Code như sau. Tôi chỉ kiểm tra 3 lần, hi vọng code không bị lỗi.
Mã:
Option Explicit

Sub dan_DL()
Dim lastRow As Long, r As Long, k As Long, start As Long, text As String, chucai_hienhanh As String, cotAC(), kq()
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("B1:C" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents   ' xoa ket qua cu
        lastRow = .Range("M" & Rows.Count).End(xlUp).Row
        If lastRow = 1 And .Range("M1").Value = "" Then Exit Sub    ' neu khong co du lieu cot M thi nghi choi
        kq = .Range("M1:N" & lastRow).Value
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If lastRow = 1 And .Range("A1").Value = "" Then Exit Sub    ' neu cot A khong co du lieu thi don do choi
        cotAC = .Range("A1:C" & lastRow + 1).Value   ' lay du 1 dong cuoi, lay 3 cot A:C
    End With
    cotAC(UBound(cotAC, 1), 1) = "Ngay mai em di"   ' nhap chu bat ky vao cuoi mang cotAC de danh dau dong ket thuc cua du lieu cuoi cung trng cot A
    For r = 1 To UBound(cotAC, 1)
        text = cotAC(r, 1)
        If text <> chucai_hienhanh Then
            If chucai_hienhanh <> "" Then
                For k = 1 To r - start  ' ghi cac dong tu start toi (r-1)
                    cotAC(start - 1 + k, 2) = kq(k, 1)  ' ghi cot M vao cot B
                    cotAC(start - 1 + k, 3) = kq(k, 2)  ' ghi cot N vao cot C
                Next k
            End If
            start = r
            chucai_hienhanh = text
        End If
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("A1:C" & lastRow).Value = cotAC
End Sub
 
Upvote 0
Em xin mạo muội gửi đáp án của mình.
Dự định tháng sau xây nhà nên các bác có ủng hộ thêm ít gạch đá thì welcome ạ.
Cột A có thể sort hay không sort, tùy.
PHP:
Option Explicit
Sub dan_DL()
Range("B1:C1000000").ClearContents
Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Formula = _
"=INDEX(M$1:M$50,COUNTIF($A$1:$A1,$A1))"
End Sub
 
Upvote 0
Mọi người ơi giúp em với ạ, em đang muốn dùng VBA tìm vị trí chữ cái xuất hiện lần đầu tiên của cột A (các chữ cái chạy theo thứ tự như cột K), sau đó copy vùng M1:N50 vào vị trí xuất hiện lần đầu tiên của chữ cái đó và xóa vùng thừa như ví dụ ạ
Góp vui
Mã:
Sub ABC()
  Dim arr(), arr2(), res$(), sRow&, sRow2&, i&, k&, tmp
 
  With ThisWorkbook.Worksheets("Sheet1")
    If .Range("A1").Value = Empty Then Exit Sub
    .Range("B1", .Range("C" & Rows.Count).End(xlUp)).ClearContents
    arr = .Range("M1", .Range("N" & Rows.Count).End(xlUp)).Value
    arr2 = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    sRow = UBound(arr): sRow2 = UBound(arr2)
    ReDim res(1 To sRow2, 1 To 2)
    For i = 1 To sRow2
      If tmp <> arr2(i, 1) Then k = 0: tmp = arr2(i, 1)
      k = k + 1
      res(i, 1) = arr(k, 1)
      res(i, 2) = arr(k, 2)
    Next i
    .Range("B1").Resize(sRow2, 2) = res
  End With
End Sub
 
Upvote 0
Cũng xin góp vui thêm 1 cách khác. Code theo ý hiểu bản thân. Không quan tâm tới việc
các chữ cái chạy theo thứ tự như cột K
Mã:
Sub ABC()
Dim Rng As Range, i&, iR&
Application.ScreenUpdating = False
Set Rng = Sheet1.Range("M1:N51")
With Sheet1
    iR = .Range("A" & Rows.Count).End(3).Row
    For i = 1 To iR
        If Application.WorksheetFunction.CountIf(.Range("A1:A" & i), .Range("A" & i)) = 1 Then
            Rng.Copy
            .Range("D" & i).PasteSpecial xlPasteValues
        End If
    Next
    .Range("D" & iR + 1).Resize(1000, 2).ClearContents
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom