彰化一整天的論壇

 找回密碼
 立即註冊
查看: 993|回復: 2

自訂函數rinstr找尋某個字串最後出現的位置

[複製鏈接]
發表於 2013-8-1 10:55:44 | 顯示全部樓層 |閱讀模式
本帖最後由 imingho 於 2013-8-1 10:57 編輯
  1. Function rinstr(ByVal t As String, ByVal s As String)
  2.     '自訂函數找尋某個字串最後出現的位置
  3.     Dim i As Integer
  4.     Dim n As Integer
  5.    
  6.     n = 0
  7.     For i = 1 To Len(t)
  8.         If Mid(t, i, 1) = s Then
  9.            n = i
  10.         End If
  11.     Next
  12.     rinstr = n
  13. End Function
複製代碼
會寫這個函數的原因,是以前寫的Excel都讓使用者把檔案名稱跟檔案類型分別輸入,但是最近改成可以選取檔案的方式.例如:
c:\excel\1.xls
我必需自己把它拆成
路徑c:\excel\
檔案1
檔案類型xls
要做這件事情,我必需知道最後一個\的位置跟檔案名稱中的.使用方式.請看底下程式
  1. Private Sub cmdSelectFile_Click()
  2.     Dim fd As FileDialog    '宣告一個檔案對話框
  3.    
  4.     Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  5.    
  6.    
  7.     fd.Filters.Clear    '清除之前的資料
  8.    
  9.     fd.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名
  10.     fd.Filters.Add "Word File", "*.txt"
  11.     fd.Filters.Add "Word File", "*.csv"
  12.     fd.Filters.Add "所有檔案", "*.*"
  13.    
  14.     fd.Show '顯示對話框
  15.    
  16.     Sheet1.Range("A5:B65535").Clear '將舊的A-B欄資料清除
  17.    
  18.    
  19.     For i = 1 To fd.SelectedItems.Count
  20.         strFullName = fd.SelectedItems(i)

  21.         
  22.         
  23.         n = rinstr(strFullName, "\")
  24.         
  25.         strFileNameType = Mid(strFullName, n + 1)
  26.         
  27.         strFullPath = Left(strFullName, n)
  28.         Sheet1.Cells(i + 4, 1) = strFullPath '顯示所選取的檔案路徑
  29.         

  30.         n = InStr(1, strFileNameType, ".")
  31.         
  32.         strFileName = Left(strFileNameType, n - 1)
  33.         strsFileType = Mid(strFileNameType, n + 1)
  34.         
  35.         Sheet1.Cells(i + 4, 2) = strFileNameType

  36.         
  37.     Next
  38. End Sub
複製代碼
回復

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  

GMT+8, 2020-2-25 13:58 , Processed in 0.112817 second(s), 18 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表