Menggunakan Find and Offset untuk membuat rentang dinamis [tertutup]

0

Saya mencoba membuat beberapa kode yang akan mengurutkan, mencari, dan menyalin data dari kumpulan data yang selalu berubah. Saya pikir saya perlu mendefinisikan variabel kemudian memiliki kode menemukan koordinat untuk variabel kemudian melanjutkan tetapi itu bisa benar-benar salah. Saya telah memasukkan ide dasar dari apa yang saya butuhkan kode untuk dilakukan dalam kode tetapi saya tidak tahu mereka sintaks untuk membuatnya berfungsi. Adakah pikiran?

Sub Organize_Data ()

Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim X As Integer
Dim Function_Name As String

Replace_Blank

'******Next line could use some "robusting" by replacing hard coded value with a search for EE status**************
    A = ActiveWorkbook.Worksheets("Raw Data").Range("F2", Worksheets("Raw Data").Range("F2").End(xlDown)).Rows.Count
Worksheets.Add().Name = "Calculations"
Find_Unit
Find_Locations
    B = ActiveWorkbook.Worksheets("Calculations").Range("B3", Worksheets("Calculations").Range("B3").End(xlDown)).Rows.Count

    C = ActiveWorkbook.Worksheets("Calculations").Range("C3", Worksheets("Calculations").Range("C3").End(xlDown)).Rows.Count

For X = 1 To B
Worksheets.Add().Name = Sheets("Calculations").Range("B2").Offset(X, 0).Value
Next X

Delete_Temp_Sheets





 ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=Range( _
    "F2:F376"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Raw Data").Sort
    .SetRange Range("B2:V376")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'*********Working code******************
Sheets("Raw Data").Select
Cells.Find(What:="EE status", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Calculations").Select
Range("B2").Select
ActiveSheet.Paste
microsoft-excel vba TonyP
sumber

Jawaban:

1

Di mana Anda mencoba menemukan "Status EE"? Batasi pencarian Anda untuk itu, dan .Findkembalikan rentang

Jadi, misalnya, sesuatu seperti (belum diuji)

Dim findIt as Range
Set findIt = Sheets("Raw Data").Cells.Find (...)
Dim lastRow as Long
lastRow = Cells(Rows.Count,findIt.Column).end(xlup).row
dim myRange as Range
Set myRange = Range(findIt, Cells(lastRow, findIt.Column))
Raystafarian
sumber