- ベストアンサー
EXCEL VBAについて
EXCEL VBAについて教えてください やりたいことは以下の通りです。 ・全シートJ列1～100行目を検索しアルファベットが含まれるセルが存在すれば 上のセルをコピーする ここまで作ったのですが上手くいきません Sub VBAsample() Dim GYO As Long For GYO = 1 To 100 If Find([a-z], LookAt:=xlPart) Then Cells(GYO, 10).Value = Cells(GYO - 1, 10).Value End If Next GYO End Sub 添削をお願いします
- yac13
- お礼率11% (2/17)
- オフィス系ソフト
- 回答数4
- ありがとう数0
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
これでどうでしょうか? Sub VBAsample() Dim GYO As Long For GYO = 1 To 100 If Cells(GYO, 10) Like "*[a-z]*" Then Cells(GYO, 10).Value = Cells(GYO - 1, 10).Value End If Next GYO End Sub
その他の回答 (3)
- DOUGLAS_
- ベストアンサー率74% (397/534)
＞アルファベットが含まれるセルが存在すれば お示しのコードでは、 [a-z] となっていますので、半角・小文字のアルファベットだけなのでしょうか？ 正規表現の使い方については、[回答番号：No.3] の web2525 さんがお示しになっていらっしゃいますが、もし、半角・大文字のアルファベットを含む場合は、 If Cells(GYO, 10) Like "*[a-z]*" Then の行を If Cells(GYO, 10).Value Like "*[A-z]*" Then となさってください（[a-Z] ではなくて [A-z] です）。 さらに、全角の大文字・小文字のアルファベットも含む場合は、 If StrConv(Cells(GYO, 10).Value, vbNarrow) Like "*[A-z]*" Then となさってください。 ご参考までに ●正規表現のようなマッチング http://officetanaka.net/excel/vba/tips/tips35.htm ●正規表現によるマッチング http://officetanaka.net/excel/vba/tips/tips38.htm
- web2525
- ベストアンサー率42% (1219/2850)
If Find([a-z], LookAt:=xlPart) Then この使い方もおかしいのですが、どう直していいのかが？ [a-z]正規表現が使えるのかどうかも？
- web2525
- ベストアンサー率42% (1219/2850)
とりあえずおかしなところ Cells(GYO, 10).Value = Cells(GYO - 1, 10).Value ループはGYO=1から始まっていますので最初の行がIF文に引っ掛かるとエラーになりますCell(0,10)は存在しません。
関連するQ&A
- Excel VBAについて
Excel VBAについて VBA初心者ですが、作業で使うファイルを使いやすくしようと思っているのですが行き詰ってしまいました。 是非、知恵をお貸しいただきたいと質問させていただきました。 フォームを使ってデータを打ち込むようにしようと思っています。 日付の列を選択するとフォームが立ち上がり、必要項目を記入するというものです。 日付欄が未記入なら「新規」、記入済みなら「修正」 という風にしたいのですが、うまくいきません・・・ 修正しようと入力しなおしても新規として新しい行に書かれてしまいます。 色々と自分で勉強して下のような書き方をしましたが、何がいけないのでしょうか。 ご指摘おねがいいたしますm(__)m Public Sub KAKIKOMI(GYO As Long) GYO = ActiveCell.Row Load UserForm1 With UserForm1 If ((GYO = 17) Or (Cells(GYO, 3).Value = "")) Then GYO = 17 .hiduke.Text = "" .bunnrui.Text = "" .tantou.Text = "" .gaku.Text = "" .memo.Text = "" Else .hiduke.Text = Cells(GYO, 3).Value .bunnrui.Text = Cells(GYO, 7).Value .tantou.Text = Cells(GYO, 8).Value .gaku.Text = Cells(GYO, 9).Value .memo.Text = Cells(GYO, 11).Value .ComboBox1.Text = Cells(GYO, 5).Value End If g_swOK = 0 .Show If g_swOK <> 1 Then GoTo TOUROKU_EXIT If GYO = 17 Then GYO = 19 Do While Cells(GYO, 1).Value <> "" GYO = GYO + 1 Loop End If ActiveSheet.Unprotect Cells(GYO, 3).Value = Trim$(.hiduke.Text) Cells(GYO, 7).Value = Trim$(.bunnrui.Text) Cells(GYO, 8).Value = Trim$(.tantou.Text) Cells(GYO, 9).Value = Trim$(.gaku.Text) Cells(GYO, 11).Value = Trim$(.memo.Text) ActiveSheet.Protect End With End Sub ちなみに、17行目が見出しで、3列目が日付欄です。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセルｖｂａ 検索対象をシートではなく、ブック全
このコードでシート内に検索文字があるかどうかを取得できるのですが 検索対象をシートではなく、ブック全体にするには どうすればいいでしょうか？ Sub Sample() If Not Cells.Find(What:="test", LookAt:=xlPart) Is Nothing Then Debug.Print "あります" Else Debug.Print "ありません" End If End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBA テキストボックスを検索
テキストボックス３に数値を入力し ExcelのA列にあるか検索をかける。 ある場合は、B列の同じ行に 「みーつけた！」と入力。 その設定で組んでみたのですが、 テキストボックス３にデータを6桁入力しようとすると 6桁目にオーバーフローエラーが出ます。 このプログラムの何処がおかしいのでしょうか？ Private Sub TextBox3_Change() Dim Number As Integer If TextBox3.Value <> "" Then '空じゃない場合 Number = TextBox3.Value Call 検索(Number) MsgBox TextBox3.Value End If End Sub Sub 検索(ByVal Number As Variant) Dim FoundCell As Range Set FoundCell = Range("A:A").Cells.Find(What:=Number, lookat:=xlPart) If FoundCell Is Nothing Then Else FoundCell.Activate Range("O" & ActiveCell.Row).Value = "みーつけた！" End If End Sub
- ベストアンサー
- Excel（エクセル）
- Excel VBA で 選択セルの一部を置換
こんにちは。お願いします。 選択セルの文字列の右端が"号"、"番地"、"番"だったときに、それを消す、というマクロを作ろうとして、以下のようになりました。 Sub adrconv() Dim c For Each c In Selection If Right(c.Value, 1) = "号" Or Right(c.Value, 2) = "番地" Or Right(c.Value, 1) = "番" Then c.Replace what:="号", replacement:="", lookat:=xlPart c.Replace what:="番地", replacement:="", lookat:=xlPart c.Replace what:="番", replacement:="", lookat:=xlPart End If Next c End Sub お気づきかもしれませんが、これでは右端の"番"だけでなくどの"番"も消えてしまうのです。 右端の文字のみ消す方法をご教示願います。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- Excel VBA スケジュールマクロ最適化
現在下記の様なスケジュール表を作成しています。 ・セル(14,3)から下方は"タスク"列 ・セル(14,5)から下方は"開始日"列 ・セル(14,7)から下方は"終了日"列 ・セル(14,8)から下方は"重要度"列 ・セル(11,11)から右側へ日付が連番で入っている ・開始日と終了日を入れると自動的に変更された行を取得し、開始/終了日の範囲でセルの塗り潰しを実行 ・重要度で色を変更し、"M"を入れると★マーク表示し、その右側へタスク名表示 ３つ質問があります。 (1)現在、セルの塗り潰しを行うのに下記の様に設定しているのですが、日付を入れてからセルの塗り潰しがされるまで若干時間がかかるのですが、何か他に良い方法は無いでしょうか？ (2)あと、終了日の最大値を取得して、セル(11,11)から右側へ伸びている日付行を自動調整したいのですが、方法が分からなくて困っています。 (3)VBA初心者の為、色々調べながら作っているのですが、継ぎはぎだらけなので、改善したらよいポイントなどがあれば教えて頂けると助かります。 ================================================================ Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Gyo As Long Dim COL As Long Dim c As Integer Dim l As Integer Dim n As Integer c = 11 l = 11 Gyo = Target.Row ' 変更した行を取得 If Gyo <= 13 Then Exit Sub ' 1～13なら無視 COL = Target.Column ' 変更した列を取得 If ((COL <= 4) Or (COL >= 9)) Then Exit Sub '開始日、終了日以外は無視 ' 計算式セット自体でもイベントが発生するのでイベントを抑制 Application.EnableEvents = False '入力した条件により、セルの塗りつぶし範囲を取得 If Cells(Gyo, 5) <= Cells(11, c) Then Do Until Cells(Gyo, 5) >= Cells(11, c) c = c + 1 Loop ElseIf Cells(Gyo, 5) >= Cells(11, c) Then Do Until Cells(Gyo, 5) <= Cells(11, c) c = c + 1 Loop End If If Cells(Gyo, 7) <= Cells(11, l) Then Do Until Cells(Gyo, 7) >= Cells(11, l) l = l + 1 Loop ElseIf Cells(Gyo, 7) >= Cells(11, l) Then Do Until Cells(Gyo, 7) <= Cells(11, l) l = l + 1 Loop End If 'セルの色をクリア Rows(Gyo).Interior.ColorIndex = xlNone 'セルの塗りつぶし範囲に色を設定 If Cells(Gyo, 8) = 1 Then For n = c To l Cells(Gyo, n).Clear Cells(Gyo, n).Interior.ColorIndex = 3 Next n ElseIf Cells(Gyo, 8) = 2 Then For n = c To l Cells(Gyo, n).Clear Cells(Gyo, n).Interior.ColorIndex = 26 Next n ElseIf Cells(Gyo, 8) = 3 Then For n = c To l Cells(Gyo, n).Clear Cells(Gyo, n).Interior.ColorIndex = 5 Next n ElseIf Cells(Gyo, 8) = "M" Then Cells(Gyo, c) = "★" Cells(Gyo, 3).Copy Cells(Gyo, c + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Cells(Gyo, 8).Select Else For n = c To l Cells(Gyo, n).Clear Cells(Gyo, n).Interior.ColorIndex = 10 Next n End If 'イベントを再開 Application.EnableEvents = True End Sub ============================================================
- ベストアンサー
- Visual Basic
- ExcelのマクロをAccessで動かすには…
今までExcelを使用していてVBAも段々と理解してきたのですが 今回Accessを使用することになって詰まってしまいました。 下のようなExcelのマクロ(VBA)があるのですが、 これをAccessでも同じように動かしたいのですがわかりません(汗) ----------------------------------------------- Sub テスト() Dim GYO As Long GYO = 1 Do Until Worksheets("テスト").Cells(GYO, 1).Value = "" If Worksheets("テスト").Cells(GYO, 1).Value >= 80 Then Worksheets("テスト").Cells(GYO, 2).Value = "合格" Else Worksheets("テスト").Cells(GYO, 2).Value = "不合格" End If GYO = GYO + 1 Loop End Sub ----------------------------------------------- これでAccessのレコード一つ一つの合否を入力する欄に 自動で入力されるようにしたいのですが、 Accessでの記述方法がよくわからないのです。(^_^;) お詳しい方、よろしくお願いしますm(_ _)m
- ベストアンサー
- その他(データベース)
- エクセル マクロ 検索
お世話になります。 範囲がA2からK221までの表があります。 検索して検索されたセルの左のセルを表示するマクロを組みたいのですが、検索する文字（数値）はE1に、検索結果はK1に表示するようにするにはどのようにしたらいいでしょうか？ Sub FIND_DATA1() ' FIND_DATA1 Macro ' マクロ記録日 : 2006/9/1 ユーザー名 : ' Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole).Activate End Sub Sub Data_Find3() Dim 対象セル As Range Dim 最初のセル番地 As String Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub End If Set 対象セル = Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole) 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Cells.FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 MsgBox "検索件数は" & 検索件数 - 1 & " 件です" End Sub 本を見たり調べたりでここまでできたんですがこれだと検索件数、検索結果が色付きになるだけで使い勝手がいまいちです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA マクロ エラー1004 アプリケーション定義またはオブジェクト定義のエラー
VBAで正当表と入力表の正誤判定を一気に行いたいのですが If Cells(a, b).Value = Cells(c, d).Value Thenの部分で エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。 エラーの対処の仕方を調べたのですがわかりませんでした。 教えていただけるとありがたいです。 以下作ったプログラムです。 Sub 正誤判定() Dim a Dim b Dim c Dim d Dim e Dim i Dim j Dim x Dim y Dim hokan Dim ytate Dim xyoko a = 3 b = 21 c = 3 d = 43 e = 2 i = 1 j = 1 Do While j < 261 Do While i < 11 If Cells(a, b).Value = Cells(c, d).Value Then a = a + 1 c = c + 1 If Cells(a, b) = Cells(c, d) Then hokan = Cells(e, b).Value ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15 xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1 Else End If Else End If a = a - 1 c = c - 1 b = b + 1 d = d + 2 i = i + 1 Loop a = a + 3 c = c + 3 e = e + 3 j = j + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA
Excel VBAで アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば ちゃんとデータが残ってくれるのでしょうか？ 誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub
- ベストアンサー
- その他(データベース)
- Excel VBA セル位置が取得できません
条件１の時、セル位置を変数(gyo1)に代入し、 条件２の時、セル位置を変数(gyo2)に代入。 その後、countif(gyo1:gyo2)として、 その数値を別のセルに表示させる。 という構文を作りたいと思っています。 しかし、adressプロパティを記述しても、「オブジェクトが必要です」とエラーが出てしまいます。 （expressionをSelectionに変えるとエラーは出ないのですが、この違いや意味ってなんでしょうか。） さらに、この構文はFor文で繰り返しているのですが、 最初にgyo1の値が「A2」となっても、次の繰り返し時、条件が一致したても、gyo1が更新されず、「A2」のままだったりします。 （イメージでは、「A10」とか、A列を下に移動していくはずです。） また、gyo1,gyo2の変数宣言は、どのようにすれば良いでしょうか。 以下、作成中のコードを記述します。 力を貸してくださいませ。よろしくお願いいたします。 row = 2 If Cells(row, 1) <> Cells(row - 1, 1) Then gyo1= Selection.Address(Cells(row, 1)) End If If Cells(row, 2) <> Cells(row - 1, 2) Then gyo2 = Selection.Address(Cells(row, 2)) End If Cells(row,5).value = countif(gyo1:gyo2)
- ベストアンサー
- Visual Basic
