人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのVBAで以下のことをする方法を教えてください。

>>
A列にある特定の文字(例:0000)を入力すると
特定のセル($F8)にフォーカスが移動する
<<

次に

>>
ワークシート1の特定のセルに特定の文字を入力すると
ワークシート2の中のセルに文字を書き込む

この場合のワークシート2のセルについて
例えば、ワークシート1のA列に$A1=2 $A2=5 $A=6とあった場合
ワークシート2のA列から2を探し
A列に2が入っているセルの5つとなりに特定の文字を書き込み
次は5を探して・・・といった具合に
同じことをワークシート1のA列セルが空になるまで行いたいのです。
<<

最後は

>>
あるイベントが発生した時に自動的に名前をつけて
(日時による名前がいいです。秒単位まであると尚良い)
エクセルを保存したい。
<<

以上3点が質問です。
どれかひとつでも結構ですので
宜しくお願いいたします。

●質問者: e23jp
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:A1 VBA ひとつ イベント エクセル
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● gong1971
●50ポイント ベストアンサー

まずは1つ目の質問から...(回答の様子をみて続けて回答させて頂きます。)


  1. [ツール(T)]メニューから[マクロ(M)][Visual Basic Editor(V)]を開きます。
  2. 画面左にワークシート名の一覧が表示されているので、該当のワークシートを右クリックし[コードの表示(O)]を開きます。
  3. 下記のコードをコピーして貼り付けます。
Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Column = 1 Then
 If Target.Value = "0000" Then
 Range("F8").Select
 End If
 End If

End Sub

※予めA列の表示形式を[文字列]にしておく必要があります。(表示形式が[文字列]以外の場合、"0000"を入力しても 0 になってしまう為。)

http://www5b.biglobe.ne.jp/~mebaru/ExcelVBA/ExcelVBA022.htm

◎質問者からの返答

おー ばっちりです!

ありがとうございます。

できればほかのものについてもお願いできますでしょうか。

宜しくお願いいたします。


2 ● gong1971
●50ポイント

次に3つ目の質問の回答です。あるイベントという事なので、

日時による名前を付けて保存するコードをご案内します。

Sub tempsave()

 Dim tmp As String
 
 tmp = ThisWorkbook.FullName
 ChDir Left(tmp, InStrRev(tmp, "\") - 1)
 tmp = ThisWorkbook.Name
 ThisWorkbook.SaveAs Format(Now, "yyyymmddhhmmss")
 Application.DisplayAlerts = False
 ThisWorkbook.SaveAs tmp
 Application.DisplayAlerts = True

End Sub

ポイントは以下の2点


バックアップファイルとして保存をしていきたいという事ですよね?ExcelのVBAでは名前を付けて保存した際に、元のファイル名は保持されないので、一度日時による名前を付けて保存を行った後に、元のファイル名で保存し直す必要があります。


単純に名前を付けて保存を行うと、意図しないパスに保存されてしまう事があります。元のファイル名と同じフォルダに保存するようにしました。


http://homepage2.nifty.com/kasayan/vba/excel7.htm

◎質問者からの返答

ありがとうございます。

あるイベントとは、質問2もそうなのですが

F17に0000が入力された時というのをイベントとして行う予定でした。

質問2についてもお願いできますでしょうか。

よろしければ是非お願いいたします。


3 ● gong1971
●50ポイント

2つ目の質問の回答です。


処理は下記コードとなります。標準モジュールシートに貼り付けてください。(質問3も同様)

Sub searchwrite()
 
 Dim tmp As String
 Dim tmpcell As Range

 Worksheets("Sheet1").Select
 Range("A1").Select
 Do
 tmp = ActiveCell.Value
 Worksheets("Sheet2").Select
 Set tmpcell = Columns("A:A").Find(What:=tmp, LookAt:=xlWhole)
 If Not (tmpcell Is Nothing) Then
 tmpcell.Offset(0, 5).Value = "特定の文字列"
 End If
 Worksheets("Sheet1").Select
 ActiveCell.Offset(1, 0).Select
 Loop While ActiveCell > ""

End Sub

※太字の部分は適宜変更してください。

※こちらのテストでは正常動作しましたが、シートの状況などにより期待の動作とならないかもしれません。テストを十分に行ってください。

http://www.moug.net/tech/exvba/0050051.htm


次にF17に0000が入力された時に処理したい場合は...

1つ目の質問で記述したSubプロシージャに次のコードを記載します。

 If Target.AddressLocal = "$F$17" Then
 If Target.Value = "0000" Then
 Call searchwrite
 Call tempsave
 End If
 End If

つまり...

Private Sub Worksheet_Change(ByVal Target As Range)

'ココの適当な位置に上記のコードを記述します。

End Sub

以上、不明な点などありましたら遠慮無く返信にてお知らせ下さい。

◎質問者からの返答

ありがとうございます。

お蔭様で大変順調に進んでいます。

tempsaveを実行した後に、セルの一部を消去して初期化するために

Range("A2:A100").ClearContents

Range("F11:F15").ClearContents

ということをしてみたのですが

これを入れると

Private Sub Worksheet_Change(ByVal Target As Range)

Dim tmp As String

If Target.Column = 1 Then

→ If Target.Value = "9999" Then

Range("F11").Select

End If

End If

のところで型が一致しないというエラーになってしまいます。

(数字は9999に変えました。セルの書式を文字列にしなくてもよくするため)

どのように対処したらよいかお教えいただけますでしょうか。

宜しくお願いいたします。


4 ● freemann
●25ポイント

質問2に対する答えです。

Sub temp2()

Dim i As Long

Dim j As Long

Dim sData As String

Worksheets(1).Select

For i = 1 To 65536

'データがあるかチェック

If Cells(i, 1).Value <> "" Then

'検索の基準データの取得

sData = Cells(i, 1).Value

'ワークシートのデータを探す

For j = 1 To 65536

'データがあるかチェック

If Worksheets(2).Cells(j, 1).Value <> "" Then

'ワークシート1と同じデータかチェック

If StrComp(Worksheets(2).Cells(j, 1).Value, sData, vbTextCompare) = 0 Then

'同じデータなら所定のところにデータを書き込む

Worksheets(2).Cells(j, 5).Value = "同じ" & sData

End If

Else

'セルが空ならワークシート2のループ終了

Exit For

End If

Next j

Else

'セルが空ならワークシート1のループ終了

Exit For

End If

Next i

End Sub

ダミー

http://q.hatena.ne.jp/1153366511


5 ● gong1971
●50ポイント

エラーメッセージの「型が一致しない」ですが、

複数セルについて編集を行うと出てしまうようです。


1つめの質問で回答した↓以下の記述を、

 If Target.Value = "0000" Then

こちら↓のように変更してください。

 If Target.Cells(1, 1) = "0000" Then

http://homepage2.nifty.com/kasayan/vba/excel2.htm


また2つ目の質問ですが、前回の回答ではワークシート2の中に該当セルは

1つのみという前提で作成しました。1つの値につき2つ以上のセルが該当する場合、

以下のコードをご使用ください。

Sub searchwrite()
 
 Dim tmp As String
 Dim tmpcell As Range
 Dim tmprow As Long

 Worksheets("Sheet1").Select
 Range("A1").Select
 Do
 tmp = ActiveCell.Value
 Worksheets("Sheet2").Select
 Set tmpcell = Columns("A:A").Find(What:=tmp, LookAt:=xlWhole)
 If Not (tmpcell Is Nothing) Then
 tmprow = tmpcell.Row
 Do
 tmpcell.Offset(0, 5).Value = "特定の文字列"
 Set tmpcell = Columns("A:A").FindNext(tmpcell)
 Loop Until tmprow = tmpcell.Row
 End If
 Worksheets("Sheet1").Select
 ActiveCell.Offset(1, 0).Select
 Loop While ActiveCell > ""

End Sub
◎質問者からの返答

ばっちりです。

はてなでこんな良回答をもらえたのは久しぶりでした。本当にありがとうございます。

また、わからないことがあればはてなで質問させていただきますので機会があればまた教えてください。

本当にありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ