エクセルの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点が質問です。
どれかひとつでも結構ですので
宜しくお願いいたします。

回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2006/07/20 12:35:13
  • 終了:2006/07/20 17:24:13

ベストアンサー

id:gong1971 No.1

gong1971回答回数443ベストアンサー獲得回数682006/07/20 12:49:31

ポイント50pt

まずは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

id:e23jp

おー ばっちりです!

ありがとうございます。

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

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

2006/07/20 12:55:57

その他の回答(4件)

id:gong1971 No.1

gong1971回答回数443ベストアンサー獲得回数682006/07/20 12:49:31ここでベストアンサー

ポイント50pt

まずは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

id:e23jp

おー ばっちりです!

ありがとうございます。

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

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

2006/07/20 12:55:57
id:gong1971 No.2

gong1971回答回数443ベストアンサー獲得回数682006/07/20 13:06:10

ポイント50pt

次に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

id:e23jp

ありがとうございます。

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

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

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

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

2006/07/20 13:24:43
id:gong1971 No.3

gong1971回答回数443ベストアンサー獲得回数682006/07/20 13:39:10

ポイント50pt

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

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

id:e23jp

ありがとうございます。

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

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に変えました。セルの書式を文字列にしなくてもよくするため)

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

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

2006/07/20 16:07:49
id:freemann No.4

freemann回答回数315ベストアンサー獲得回数502006/07/20 14:36:50

ポイント25pt

質問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 

id:gong1971 No.5

gong1971回答回数443ベストアンサー獲得回数682006/07/20 16:59:02

ポイント50pt

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

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


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
id:e23jp

ばっちりです。

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

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

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

2006/07/20 17:22:45

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません