|
× [PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。 |
 |
|
Find …・1 0ption Explicit Sub検索1() Range(″G:G″).Find(What:=″USD″).Select '見つかつたセルを選択 End Sub Sub検索2() Dim lngYLine As Long Dim intXLine As integer Dim Obj As Object Set Ob」=WorkSheets(″Sheetl″).Celis.Find(″りんご″,LookAt:〓xlWhole) '全て一致/一部一致は、LookAt:=xlPart MsgBox″りんごは見つかりませんでした。″ Else ingYLine = Worksheets(″Sheetl″).Cells.Find(″りんご〃, LookAti〓xlWhole).Row intXLine = Worksheets(″Sheetl″).Cells.Find(″りんご″, LookAt:=xlWhole).Oolumn MsgBox″りんごは、″+CStr(lngYLine)+″行日の″_ +CStr(intXLine)+″列目にあります″ End lf End Sub Sub検索3() '検索がエラーになる(見つからない)と実行時エラーになる D:m x As String Dim y As Long x=″JPYあ″ 'OK y = Oolumns(3).Find(What:=x, LookAti〓xlWhole).Row y 〓 Oolumns(″G″).Find(Whati=x).Row y = Oolumns(″C:G″).Find(What:=x).Row Oolumns(″C:C″).Find(x).Select 'エラー 'y 〓 Columns(″3″).Find(what:=x).Row 'y = Oo!umns(C).Find(what:=x).Row MsgBox y 'LookAt:〓xlPart一部が一致するセルを検索 'LookAt:=xlWhoie全てが一致するセルを検索 '※検索範囲に結合セルがある場合は、結合セルをすべて含んだ範囲を指定すること End Sub Sub検索4() Dim f As Var!ant Dim e As Varlant Dim l As Var:ant '上表の空白行を削除 f = Range(″A:A″).Find(What:=″1″).Row '表の1行日 , eM:g::II♀(1'″1)・in:(XIDown).Row '表の最終行 For l = f To e lf Cells(1, 2) = ″″ Then Exit For Next Rows(i & ″:″ & e).Delete '下表の空白行を削除 e=ActiveSheet.UsedRange.Rows.Oount 'シートの利用最終行 f〓Range(Cells(:,1),Cells(e,1)).Find(Whatl=″1″).Row'表の1行日 e〓Ceils(f,1).End(xlDown).Row '表の最終行 ' MsgBox f & ″ ″ & e For ! 〓 f To e lf Cells(i, 2) 〓 O Then Exit For Next Rows(i & ″:″ & e).Delete Find ―'2 Range(Cells(5, 1), Celis(: - 1, 12)).Select End Sub Sub検索5() Range(″C:C″).Find(Whati=″USD″).Offset(0, 1).Select End Sub Sub検索置換1() '日付データの置換 Dim day(2) As Date 'コ巨ヨ妻: ″ day(1) 〓 ″2015/10/2″ day(2) = ″2015/10/3″ Cells.Replace What:=day(1), Replacementi=day(2), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormati=False End Sub Sub検索置換2() 'ワークシートの置換表を利用 '「特例1」セル範囲を参照置換、該当しなかつたら「特例2」セル範囲を参照置換 e(1)=Range(″A10″).End(xlDown).Row '表の最終行 For : 〓 10 To e(1) lf lsError(Application.Match(Cells(1,j),ThisWorkbooko Worksheets(″参照データ″).Range(″特例1″),0))Then Else Ce!ls(i, j).Value = Application. index(ThisWorkbook.Worksheets(″彪歩賢瞑テ゛…夕″).Range(″牛キタ刑2″), _ App:lcation.Match(Cells(1, j), ThisWorkbook.Worksheets(″ゼ歩曼瞑テ゛―夕″).Range(″中キ椰″) ,0),0) End lf Next End Sub Subループ0 i=1 Do While Cells(i, 1) く〉 ″ABC″ lf i = Cells.Rows.Oount Then 'シート終端に達したら、ループを抜ける Exit Do End lf i〓i+1 Loop For i = x To 6 tmp = Split(Cells(1, 1), vbLf) Cells(i, 2) = tmp(0) tmp 〓 Split(tmp(1), ″: ″) Cells(i, 3) = tmp(1) Next i End Sub Subフィルタの設定0 Dim j As Long j=Range(″B4″).End(xlDown)Row'最下行取得 , Range(Cells(411),Cells(j,22)).AutoFilter Field:=2,Criterial:=″◇レポ取引″ 'フィルタリング Rows(″5:″&j).Delete 'フィルタリング結果(見えている)行だけを削除 l:[早;`:illi.(lhnlを'(″:ill:sl:143'|キLl:「♀「1:leli:|:|」:=2 1:;:|サ♭多|サンgillミ:3 Range(″Al″).AutoFilter 'フィルタ解除 End Sub Subフィルタリング状態でのコピー0 'フィルタリング状態で見えている行だけをコピー 'ただし、貼付先はフィルタリングされないので注意 '要確認 Fi nd - 3 Range(″AM4:AM1500″).Select 'いらない? Selection.SpecialCel:s(xlCellTypeVisible) Select Selection.Copy Range(″L4〃).Select Selection PasteSpecial Paste:=xlPasteVaiues, operation:=xlNone, Sk:pBlanks:=Fa:se, Transpose:=False End Sub Subフィルタリング後削除0 Dim r As Range 'オートフィルタ 抽出条件″=″(空欄) Range(″A9″).AutoFilter Field:=1, Criterial:=″=″ 'MsgBox″条件Aで抽出しました″ 'rに項目行(A9)は消さないので、A10～A列最終行の"見えているセル"の値をセットしその値をクリア Set r 〓 Range(Range(″A10″), Range(″A″ & Rows Count).End(xlUp)).SpecialCe::s(xlCellTypeVisible) r ClearContents 'MsgBox″可視セルをクリアしました″ 'オートフィルタクリア Range(″A4″) AutoFilter Field:=1 ''オートフィルタを解除 'Range(″Al″).AutoFilter 'MsgBox″ォートフィルタを解除しました″ ''rにセットした範囲で空白セルのある行(A列がクリアされた範囲)を削除し、上に詰める 'r.SpecialCel:s(xlCellTypeBlanks).EntireRow.Delete 'MsgBox″条件Aのあつた行を削除し、上に詰めました″ End Sub SubオートフィルタのONOFFの照会0 1f ActiveSheet.AutoFilterMode Then Range(″Al″).AutoFilter MsgBox″設定されていましたので、解除しました。″ Else Range(″Al″).AutoF:lter MsgBox″設定されていませんでしたので、設定しました。″ End if End Sub Subフィルタリングされているかの照会0 1f ActiveSheet.AutoFilter∥ode Then lf ActiveSheet.AutoFIlter.FilterMode Then MsgBox″絞り込まれています″ Else MsgBox″絞り込まれていません″ End lf End lf End Sub Subエラー値の取得0 1f VarType(ActiveCell.Value) = 10 Then lf ActiveCell.Value = CVErr(xlErrValue) Then MsgBox ″#VALUEl″ Else ヽ MsgBox″違うエラー″ End lf End lf . lf lsError(ActiveCell Value) Then lf ActiveCell.Value = CVErr(x:ErrValue) Then MsgBox ″#VALUEl〃 Else MsgBox″違うエラー″ End lf End if 'VarTypeは値の内容を返す。 'エラー値は10 'CVErrはエラーの内容を特定する Fi nd ―-4 'CVErr(xlErrValue)は #VALUE! 'VarTypeは:sErrorでもよい lf lsError(ActiveCell Value) Then lf ActiveCell.Value 〓 CVErr(xlErrValue) Then MsgBox ″#VALUE!″ Else MsgBox″違うエラー″ End lf End !f End Sub Sub並べ替え_Sort O ′ '①並べ替えの条件の設定 With ActiveSheet.Sort.SortFields .Clear '現在の並べ替え条件(パラメータ)をクリア .Add Keyl:〓Range(″C2″), Orderl:=xlAscending, DataOptionl:=xiSortNormal, _ Key2:=Range(″E2″), Order2:=xlDescending, DataOption2:=xlSortNormal, _ Key3:=Range(″W2″), Order3:〓xlAscending, DataOption3:=xlSortTextAsNumbers End With '※各引数の説明(☆省略すると規定値設定になる) 'Key 並べ替えの基準となるフィールド(3種類指定可) 'Order ★x:Ascending:昇順(既定値)、xlDescending:降順(3種類指定可) 'DataOption★xlSortNormaに数値とテキストを別々(既定値)、xlSortTextAsNumbers:テキストを数値データとみなす(3種 類指定可) '②並べ替えの実行その1(★引数を省略すると規定値設定になる) With ActiveSheet.Sort .SetRange Range(″A2:Z100″) '並べ替える範囲を指定 ダぁザeader=xlYes '★xlNo:ヘッダなし(既定値)、xlGuess:ヘッダカシbるかどうかチェック、xlYes:ヘッ .OrderCustom=1 '★ューザー定義の並べ替えリスト内の番号を示す1から始まる整数、省略すると通常 の並べ替えを使用 .MatchCase=False '★False:大文字と小文字を区別しない(既定値)、Truei大文字と小文字を区別 .Orlentation = xlTopToBottom 'り好摂斗SaFtRowsニィ予塵自中菫 各文どあ燃薔雲あ7:;i憲りがな順 ★XIPinYin:中国語の| .Apply '並べ替えを実行 End W:th '②並べ替えの実行その2 Range(″A2:Z100″).Sort Keyl:〓Range(″C2″)0 0rderl:=xlAscendin`しHeader:=xlYes End Sub PR |
|
|
|
|
|
