[巨集VBA]初心者學習心得02:找到工作表的最後一列lastrow,讓某個sheet工作表sheet activate,找到某個header標頭欄位,鍵值比對快速範例,Range取範圍

2018-09-15

找到工作表的最後一列lastrow：

Option Explicit

Sub GetLastRow()
    Dim wkbSource As Workbook

    Dim strSourceFileToOpen As String
    strSourceFileToOpen = ""
    '透過dialog視窗取得檔案名稱
    strSourceFileToOpen = Application.GetOpenFilename _
    (Title:="請選擇 要取得最後一列的excel 的檔案", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    
    If strSourceFileToOpen = "False" Then
        MsgBox "選取 要取得最後一列的excel 的檔案失敗！.", vbExclamation, "Sorry!"
        Exit Sub
    Else
        Set wkbSource = Workbooks.Open(strSourceFileToOpen)
        wkbSource.Activate
    End If
    Dim intActiveSheetNoInSourceFile As Integer
    intActiveSheetNoInSourceFile = 1
    Dim wsSource As Worksheet
    Set wsSource = wkbSource.Sheets(intActiveSheetNoInSourceFile)

    '關掉畫面上的資料的更新：    
    Application.ScreenUpdating = False
    Dim longLastRowOfSourceFile As Long
    longLastRowOfSourceFile = GetLastRowByColumnName(wsSource, "Invoice Date")
    Dim longLastRowOfSourceFile1 As Long
    longLastRowOfSourceFile1 = GetLastRowByRange(wsSource,FindColumn(wsSource, "Invoice Date") )
    '打開畫面上的資料的更新：    
    Application.ScreenUpdating = True

    MsgBox "透過欄位名稱取得最後一列:GetLastRowByColumnName()=" & longLastRowOfSourceFile
    MsgBox "透過Range()變數取得最後一列:GetLastRowByRange()=" & longLastRowOfSourceFile1


End Sub

'刪除空白的列
Sub DeleteBlankRows(ws As Worksheet)
    Dim longCellLastRow As Long
    longCellLastRow = GetLastRowByColumnName(ws, "Invoice Date")
    Dim r As Range, rows As Long, i As Long
    Set r = ActiveSheet.UsedRange
    rows = r.rows.Count
    For i = rows To (longCellLastRow + 10) Step (-1)
        If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
    Next

End Sub

'尋找某個欄位
Function FindColumn(ws As Worksheet, strColumnName As String) As Range
    Dim FoundColumn As Range
              
    Set FindColumn = ws.rows("1:1").Find(strColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

'取得最後一列lastrow
Function GetLastRowByRange(ws As Worksheet, rangeColumn As Range) As Long
    Dim longLastRow As Long
    longLastRow = ws.Cells(rows.Count, rangeColumn.Column).End(xlUp).Row
    GetLastRowByRange = longLastRow
End Function

'取得最後一列lastrow
Function GetLastRowByColumnName(ws As Worksheet, strColumnName As String) As Long
    Dim longLastRow As Long
    longLastRow = ws.Cells(rows.Count, FindColumn(ws, strColumnName).Column).End(xlUp).Row
    GetLastRowByColumnName = longLastRow
End Function

完整範例下載:
https://drive.google.com/drive/folders/1nrkNjIdL94WvJX12c_xqfAhtpYV7HNKb?usp=sharing

讓某個sheet工作表activate

Dim sheetName As String
sheetName = "BEFORE"
Worksheets(sheetName).Activate

找某個header標頭欄位：

Option Explicit

Sub Find_header_column()
    Dim wkbSource As Workbook

    Dim strSourceFileToOpen As String
    strSourceFileToOpen = ""
    '透過dialog視窗取得檔案名稱
    strSourceFileToOpen = Application.GetOpenFilename _
    (Title:="請選擇 要被尋找header 的檔案", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    
    If strSourceFileToOpen = "False" Then
        MsgBox "選取 要被尋找header！.", vbExclamation, "Sorry!"
        Exit Sub
    Else
        Set wkbSource = Workbooks.Open(strSourceFileToOpen)
        wkbSource.Activate
    End If
    Dim intActiveSheetNoInSourceFile As Integer
    intActiveSheetNoInSourceFile = 1
    Dim wsSource As Worksheet
    Set wsSource = wkbSource.Sheets(intActiveSheetNoInSourceFile)

    '關掉畫面上的資料的更新：
    Application.ScreenUpdating = False
    Dim rangeProductNoColumn As Range
    Set rangeProductNoColumn = FindColumn(wsSource, "productno")
    
    
    '打開畫面上的資料的更新：
    Application.ScreenUpdating = True
    
    MsgBox "productno是第" & rangeProductNoColumn.Column & "個欄位"
    
End Sub

'尋找某個欄位
Function FindColumn(ws As Worksheet, strColumnName As String) As Range
    Dim FoundColumn As Range
              
    Set FindColumn = ws.Rows("1:1").Find(strColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

完整範例下載:
https://drive.google.com/drive/folders/10oVSuzkRjtOJ-5ohB9M6-lMttIzfRulb?usp=sharing

鍵值比對快速範例：
內容沒什麼難度以及問題，就是兩個工作表sheet在比對鍵值，放這邊一份copy，方便以後快速複製貼上

'vlook對照：if 處理中的sheet.Line ID == PD 102.Supplier So Shipment No
'PD 102.Cust Name+Sales Name copy回 處理中的sheet.Customer+Sales

'找出處理中的sheet的Line ID欄位
Dim FoundBeforeLineID As Range
Set FoundBeforeLineID = Sheets("BEFORE").Rows("1:1").Find("Line ID", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'找出處理中的sheet的Customer欄位
Dim FoundBeforeCustomer As Range
'找出某某欄位
Set FoundBeforeCustomer = Sheets("BEFORE").Rows("1:1").Find("Customer", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'找出處理中的sheet的Sales欄位
Dim FoundBeforeSales As Range
Set FoundBeforeSales = Sheets("BEFORE").Rows("1:1").Find("Sales", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)



'找出PD 102的Supplier So Shipment No
'PD 102這個sheet，從RowNumber = 4開始才有資料，因此才會寫Rows("1:4")
Dim FoundPD102Supplier As Range
Set FoundPD102Supplier = Sheets("PD 102").Rows("1:4").Find("Supplier So Shipment No", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'找出PD 102的Cust Name
Dim FoundPD102CustName As Range
Set FoundPD102CustName = Sheets("PD 102").Rows("1:4").Find("Cust Name", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'找出PD 102的Sales Name
Dim FoundPD102SalesName As Range
Set FoundPD102SalesName = Sheets("PD 102").Rows("1:4").Find("Sales Name", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'開始逐筆檢查Line ID
''找出Line ID的最後一筆
lastrow = Sheets("BEFORE").Cells(Rows.Count, FoundBeforeLineID.Column).End(xlUp).Row
For i = 2 To lastrow
	
	Dim lineID As String
	lineID = Sheets("BEFORE").Cells(i, FoundBeforeLineID.Column)
	'到PD 102工作表跟Supplier So Shipment No欄位比對
	lastrowPD102 = Sheets("PD 102").Cells(Rows.Count, FoundPD102Supplier.Column).End(xlUp).Row
	Dim custNamePD102 As String
	custNamePD102 = "N/A"
	Dim salesNamePD102 As String
	salesNamePD102 = "N/A"
	
	For ii = 5 To lastrowPD102
		Dim compareValue As String
		compareValue = Sheets("PD 102").Cells(ii, FoundPD102Supplier.Column)
		If lineID = compareValue Then
			'順利比對到key值的時候, 就要複製回去處理中的工作表
			custNamePD102 = Sheets("PD 102").Cells(ii, FoundPD102CustName.Column)
			salesNamePD102 = Sheets("PD 102").Cells(ii, FoundPD102SalesName.Column)
							
			Exit For
		End If
		
	Next
			
	Sheets("BEFORE").Cells(i, FoundBeforeCustomer.Column) = custNamePD102
	Sheets("BEFORE").Cells(i, FoundBeforeSales.Column) = salesNamePD102
	
	
Next

Range取範圍：

'先取出最後一列
Dim FoundBeforeAITPin As Range
Set FoundBeforeAITPin = Sheets("BEFORE").Rows("1:1").Find("AIT P/N", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
lastrow = Sheets("BEFORE").Cells(Rows.Count, FoundBeforeAITPin.Column).End(xlUp).Row
'再根據find header的range去設定客製化的range
Dim FoundRate As Range
Set FoundRate = Sheets(sheetName).Rows("1:1").Find("R", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
Dim rateRange As Range
Set rateRange = Range(Chr(FoundRate.Column + 64) & "2:" & Chr(FoundRate.Column + 64) & lastrow)
rateRange.Value = InputBox("請輸入匯率")

參考資料：
Range Object - Excel Easy
https://www.excel-easy.com/vba/range-object.html

巨集VBA

回首頁

kevinya

低調

[巨集VBA]初心者學習心得02:找到工作表的最後一列lastrow,讓某個sheet工作表sheet activate,找到某個header標頭欄位,鍵值比對快速範例,Range取範圍

標籤雲