返回列表 上一主題 發帖

[發問] 指定儲存格文字轉大寫

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
1# 跳轉到 »
發表於 2012-4-6 13:44 | 顯示全部帖子
引用G大大的寫法~ 自己改一改就好了~
  1. Sub uppera() '全部大寫
  2.     Dim E As Range, Rng As Range
  3.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  4.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  5.     For Each E In Selection.SpecialCells(xlCellTypeConstants)

  7.             E.Value = UCase(E)                          '全部轉換為大寫

  9.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  10.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串

  12.     Next
  13. End Sub
  14. Sub upperaf()  '第一個字大寫


  17.     Dim E As Range, Rng As Range
  18.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  19.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  20.     For Each E In Selection.SpecialCells(xlCellTypeConstants)

  22.             E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫
  23.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  24.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串

  26.     Next
  27. End Sub
複製代碼
回復 3# PJChen
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 2012-4-6 14:14 | 顯示全部帖子
回復 3# PJChen

再引用G大大的寫法~ 自己改一下~
程式設計前要先分析一下想要的結果是什麼~ 再怎麼來寫~
依您需要的東西~
按下任一個按鈕時~ 不管是開新檔或是執行該檔內的內容~ 就進行字的大寫調整
因此用一個IF 來判斷~ 是要執行該檔案還是執行新開的檔案
所以加了一個打開EXCEL的指令,判斷是不是要開檔案,
來完成最後的結果~
  1. Sub uppera() '全部大寫
  2. patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
  3. If patch = False Then
  4.     Dim E As Range, Rng As Range
  5.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  6.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  7.     For Each E In Selection.SpecialCells(xlCellTypeConstants)
  8.             E.Value = UCase(E)                          '全部轉換為大寫
  9.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  10.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串
  11.     Next
  12. Else
  13.     With Workbooks.Open(patch)
  14.         For Each E In .Sheets("工作表1").Range("A:C")
  15.           E.Value = UCase(E)
  16.         Next
  17.     End With
  18. End If

  20. End Sub
  21. Sub upperaf()  '第一個字大寫
  22. patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
  23. If patch = False Then
  24.     Dim E As Range, Rng As Range
  25.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  26.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  27.     For Each E In Selection.SpecialCells(xlCellTypeConstants)
  28.             E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫                          '全部轉換為大寫
  29.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  30.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串
  31.     Next
  32. Else
  33.     With Workbooks.Open(patch)
  34.         For Each E In .Sheets("工作表1").Range("A:C")
  35.           E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫
  36.         Next
  37.     End With
  38. End If

  40. End Sub
複製代碼
學習才能提升自己

TOP

        靜思自在 : 做該做的事是智慧，做不該做的事是愚癡。
返回列表 上一主題