- ベストアンサー
エクセル2010 マクロ 追加質問です
http://okwave.jp/qa/q8552794.html 上記質問への追加です。 宜しくお願いします。 下記、c.Offset(0, 6).Textの右へ2列目のJ列に3300で始まる10桁の数字があります。 そこから上に向かって1100で始まる10桁の数字を見つけて メッセージで「これは1100XXXXXXのグループです」と表示させたいです。 但し途中に空白セルもあります。 With Ws1 For Each c In .Range("B2", .Cells(Rows.Count, 2).End(xlUp)) 'C,E,F,H を検索 s = c.Offset(0, 1).Text & c.Offset(0, 3).Text & c.Offset(0, 4).Text & c.Offset(0, 6).Text 【例】 J2 1100123456 J3 1100456789 ←ここをメッセージで表示したい J4 空白 J5 3300987654 ←ここが検索対象の場合 J6 1100654321
- maron1010
- お礼率64% (38/59)
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- エクセルの簡単なマクロ機能を追加したいのです
既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： Sheet2のC列に 0 があれば Sheet1のB列に 愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- 締切済み
- その他MS Office製品
- エクセル VBA マクロについて
VBA初心者です。 Sub 記入() Range("H8", "J14").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H15", "J21").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H22", "J28").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("K13").Select End Sub こういうマクロを作り上手く作動しましたのでB列に日付を記入したいと思い Sub 日付() Range("("B" & Rows.Count).End(xlUp).Offset(1)","("C" & Rows.Count).End(xlUp).Offset(0, -1)").Value = Date End Sub このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- EXCEL 最終行に入力するマクロ
マクロ初心者です。 シート”受注書”からシート”受注履歴”に 履歴情報を書き込むマクロを作成しています。 初心者丸出しで恥ずかしいのですが、 下記のように組んでいます。 Sub 受注情報書き込み() Dim ws01 As Worksheet Dim ws02 As Worksheet Set ws01 = Worksheets("受注書") Set ws02 = Worksheets("受注履歴") ws02.Activate ' 受注No入力 ws01.Range("C2").Copy ws02.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ' 受注日入力 ws01.Range("M2").Copy ws02.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ' 出荷日入力 Sheets("粗利報告書").Range("D3").Copy ws02.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues ・ ・ ・ この場合、受注書シートが空白の場合、 受注履歴シートも空白になると思うのですが、 次回、履歴を書き込む時に空白を詰めて（最終行に） 入力してしまう事を避けたいです。 空白は残しつつ、一受注を同じ列に入力する為には、 どうしたら良いでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセル 2010 マクロ 検索
http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD 、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim strKey As Variant Dim s As String Dim c As Range, bln As Boolean Dim rng1 As Range Dim cnt As Long Set Ws1 = Sheet1 Set Ws2 = Sheet2 Ws1.Select With Ws2 strKey = Application.Transpose(.Range("A1").Resize(2).Value) strKey = Join(strKey, "") End With If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub With Ws1 Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) For Each c In rng1.Offset(, -10) 'D,E,F,G,H,I,Kを検索 s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then c.End(xlToRight).Activate c.Offset(0, 2).Value = Date c.Resize(1, 14).Interior.ColorIndex = 6 bln = True Exit For End If Next c If Not bln Then Ws2.Select MsgBox "リストに存在しません", vbExclamation, "NotFound" Else '加える Call ReSearch(Ws1.Range("M2"), c.Row) '再設定 Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation End If End With Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) Dim i As Long Dim cnt As Long For i = 1 To rng1.Rows.Count If VarType(rng2.Cells(i, 1)) = vbDouble Then If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then cnt = cnt + 1 End If End If Next i DoubleCountBlank = cnt End Function 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- Excel 2007 マクロ 別シートの情報を反映する方法
Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
- エクセル マクロ修正
シート１～５まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにＡ１～Ａ１０のセルに日付、B1～B10のセルに文字など入力がするところがあります 入力はＡ１から順番に入れていきます 例えば 保存ボタンを作成しておく シート１のA1に日付、B１に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのＡ列にシート名、Ｂ列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2：C4に日付を入れる 結合セルL２：L３０に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか？ 試したことAをB2にかえ、BをL２にしたら変なことになりました・・・
- ベストアンサー
- Excel（エクセル）
- エクセルの質問です
A列は空白 B列に商品をあらわ５桁のコードが入っています。 C列にも同じく商品を表す５桁のコードが入っているのですが、 B列のセルと隣り合ったセルには同じ数字が入っていません。 D列には取引先の会社名が入っています。 B１に入ってる５桁の数字と同じ数字が入っている C列のセルを探し、 そのセルの隣のD列の会社名をA1のセルに表示させたいのですが、 どう関数を組んだらいいのでしょうか？ A B C D 12345 12354 A社 12334 12345 B社 12443 12544 C社 上の表の場合B1とC2数字が同じなのでA1にB社と表示させたいのです。
- ベストアンサー
- オフィス系ソフト
- Excelのマクロについて教えてください。
Excelのマクロについて教えてください。 下記のマクロがあります。 With Range("A" & Rows.Count).End(xlUp) .EntireRow.Copy .Offset(1) .Offset(1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents .Offset(1).Value = .Value + 1 End With 実際にデータが入っているのはA列～E列までで .EntireRow（行全体）ではなく A?:E? と範囲を指定して上記を実行させたいのですが どのように変更するといいでしょうか。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel 2007 マクロのIF構文について
Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub
- ベストアンサー
- その他MS Office製品
- 最終行の空白セルに右上がり斜線を引く
Ｂ列を検索して最終行を選び、C列～Ｇ列の中から空白セルを探して、右上がり斜線を引く。 Cells(Rows.Count, 2).End(xlUp).Offset(, 1).Resize(, 5). _ Borders(xlDiagonalUp).LineStyle = xlContinuous データーの入っているセルにも、斜線が引かれてしまいます。 空白セル（変動します）にのみ、斜線を引くことができるようにしたいのです。 よろしくお願いします。
- ベストアンサー
- その他（プログラミング・開発）
- MFC-J1605DNのインクを入れ替えても正常に認識されず、表示が？？？になる問題について相談です。
- お使いのMFC-J1605DNでインクを入れ替えたところ、表示が？？？になり、印刷ができなくなりました。
- インクを交換してもMFC-J1605DNが正常に動作せず、？？？と表示されるトラブルについて相談です。
お礼
ありがとうございます。 ほぼ、思うように出来ました。 「ほぼ」というのは、私の伝え方が稚拙な為、 誤解や不要な考え込みを起こさせてしまいました。 「 "これは1100XXXXXXのグループです"」の箇所が メッセージボックスで表示させたかったのですが、 自己流にコードを入力してみましたら、なんとか表示されましたので 結果的には問題ありませんでした。 また、「.Text」プロパティの件ですが、 ご指摘のとおり、実際には「.Value 」で対応しています。 ご心配、ご指摘ありがとうございます。 正直言いますと実際のデータの列並び、構成は これらのコードと若干違いますこと、ご了承ください。 更なる質問もありますので、是非、次回もお願いしたい次第です。 今回はありがとうございました。