- 締切済み
エクセルVABマクロで教えてください
顧客管理をエクセルでしているのですが、今使用しているマクロを一部変更を考えているのですが、 名簿シ－トに１８項目ほどあり備考欄として４セル分（１５番目から１８番目を空欄としている）へ請求書を発行したら１７番目へ"請求書"を入力できるようにしていたのですが、１５～１８の空セルを探して開いているところへ入力を考えています。 １５と１６番目のセルは書式設定で１１と１２番目のセルへ"×"，"1"が入力されたら文字が出るようにしています。 結局"請求書"をいれるのは１７か１８になりますが。 その部分のマクロは下です。 Dim rngFC As Range With Sheets("名簿") rngFC.Offset(0, 17).Value = "請求書" rngFC.Offset(0, 11).Value = "×" rngFC.Offset(0, 12).Value = "1"
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- bin-chan
- ベストアンサー率33% (1403/4213)
関連するQ&A
- エクセルマクロで上書きして貼り付けの方法は
エクセルのマクロでコピーして貼り付けする場合、貼り付けするセルに何か入力されているとその次の行に飛んで貼り付けしてしまいます。 何か入力されていても上書きで貼り付けする方法を教えてください。次のマクロを参考にお願いします。 Sub 全体名簿へ2組() ' ' 全体名簿へ2組 Macro ' ' 開始 = Range("r3").Value 終了 = Range("s3").Value Range("B" & 開始 + 1 & ":n" & 終了 + 1).Select Selection.Copy Windows("全体名簿.xlsm").Activate Sheets("★名簿").Select Range("B65536").End(xlUp).Offset(1).Select ActiveSheet.Paste End Sub このActiveSheet.Pasteを変えるとできるのかその方法がわかりません。 また，貼り付けする前に選んだセル以降の行をクリアーにしてから、貼り付けすればできますがその範囲の指定の仕方はどうすればいいのでしょうか。マクロの文も教えていただきたいです。
- ベストアンサー
- その他MS Office製品
- excel vbaでの質問になります
このようなマクロを作成したのですが、セルに数式が入れてあると、どうしてもその下の空白の行に値を入力されてしまいます。 数式が入っているセルにもそのままセルに値を入れたいのですが・・ 宜しくお願いします。 Dim wb1 As Worksheet, r1 As Range Dim N As Integer, i As Integer Dim mycount As Long Set wb1 = ThisWorkbook.Worksheets("請求書") mycount = Range("B111").CurrentRegion.Rows.Count Cells(111 + mycount, 2).Select ActiveCell.Offset(0, 0).Value = wb1.Range("C60").Value ActiveCell.Offset(0, 1).Value = wb1.Range("C61").Value ActiveCell.Offset(0, 12).Value = wb1.Range("C66").Value ActiveCell.Offset(0, 13).Value = wb1.Range("C74").Value ActiveCell.Offset(0, 14).Value = wb1.Range("C75").Value ActiveCell.Offset(0, 15).Value = wb1.Range("C84").Value ActiveCell.Offset(0, 16).Value = wb1.Range("C85").Value ActiveCell.Offset(0, 20).Value = wb1.Range("C69").Value ActiveCell.Offset(0, 22).Value = wb1.Range("C68").Value ActiveCell.Offset(0, 23).Value = wb1.Range("C76").Value ActiveCell.Offset(0, 24).Value = wb1.Range("C77").Value Exit Sub
- 締切済み
- Visual Basic
- エクセル マクロ 抽出
教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで
http://oshiete1.goo.ne.jp/qa727693.htmlの質問の回答を参考に Private Sub CommandButton1_Click() Dim Meibo As Worksheet Dim Kojin As Worksheet Dim Rng As Range Dim R As Range Set Meibo = Worksheets("名簿") ' Set Kojin = Worksheets("表") ' Set Rng = Meibo.Range("A2:A51") ' For Each R In Rng Kojin.Range("L4").Value = R.Value ' Kojin.PrintOut Next R Set Meibo = Nothing Set Kojin = Nothing End Sub というマクロを組み、コマンドボタンのクリックで名簿ひとりひとりの名前を表に印刷する事が出来ました。 ただ名簿の範囲 A2:A51が常に埋まってるわけでなく、一人、二人 少ないことがあるのですが、その状態でマクロを実行すると名前が 空欄の表も印刷されてしまいます。 そこで、「範囲はA2:A51で空欄は印刷しない」というようなコマンド設定は出来ないものでしょうか？ 印刷するたびに、A2:A51の範囲を変えてやるしかないんですか？ まだまだマクロについては勉強不足なもので、よろしくご指導のほど 願います。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロで教えてください
Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。
- 締切済み
- オフィス系ソフト
- エクセル マクロ：文字変更
教えてください。 sheet5にデータがあります。 マクロを実行すると、一番右の列のセルに○があると●と書き換える 一番右の列のセルに△があると▲と書き換えるコードを作成しています。 下記のコードでは時間がかかってしまいます。 省略 If Sheets("sheet5").Cells(r, cmax).Value = "○" Then Sheets("sheet5").Cells(r, cmax).Value = "●" 省略 AutoFilterを使用してマクロを作成しましたが、列に○と△が両方無いと 範囲指定したセルがすべて▲となってしまいます。 下記コードをどのように手直ししたらよいのか教えて頂けないでしょうか。 よろしくお願いします。 Sub 文字変更() Dim c As Integer Dim cmax As Integer Dim rmax As Long With Sheets("sheet5") rmax = .Range("A3").End(xlDown).Row cmax = .Range("A3").End(xlToRight).Column .Rows("1:1").Select Selection.AutoFilter For c = 2 To cmax Selection.AutoFilter Field:=c, Criteria1:="○" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "●" Selection.AutoFilter Field:=c, Criteria1:="△" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "▲" Selection.AutoFilter Field:=c Next c End With Selection.AutoFilter End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル 決算マクロ
Dim s Dim h As String Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Cells(3, 2).Value For Each ws In Worksheets s = ws.Index Next ws For k = 5 To s Step 1 Set KaMoku = Sheets(k).Range("D3:J103").Columns(1) MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) n = n + MyUNo Sheets("決算").Cells(3, 5).Value = n Next k End Sub 自治会の決算書を作りたいので上記のようなマクロを、インターネットで調べながら 私の知識のない頭をフル回転させて書いてみたのですが。 h = Sheets("決算").Cells(3, 2).Valueで、ｈへの値の代入が一つのセルからの代入ではなくて h = Sheets("決算").Range("B3:B103").Valueのように範囲から文字をさがしたいのです。 それと MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) AND MySNo = Application.WorksheetFunction.Match(K, KoKaMoku, 0) のように、この文字が同じで、次の列のこの文字も同じ時に MyUNo = KaMoku.Cells(MySNo).Offset(, 4) ４列目の値を n = n + MyUNo Sheets("決算").Cells(3, 5).Value =（ではなくて） ここも、一致した文字のあるセルの隣のセルに数値を入れたいのですが、うまくいきません。どうか私に、あなたの素晴らしい知恵をかしてください。 お願いします。
- ベストアンサー
- Visual Basic
- Excelのマクロについて
マクロの書き方について質問です。 今回、やりたいことは以下のとおりです。1つのボタンを押して動くようにしたいのです。添付画像を参照して下さい。 ・各シートごとにファイル名を指定しPDFで保存したい。 「住所録」の発送日、法人名、氏名を反映（例：20130301株式会社HOGEHOGE阿賀川）。 ・各シートを印刷する。 現在は添付画像の様にエクセルで納品書などを作成しています。 左上の「納品書」「請求書」「領収書」のボタンを押すと、「住所録」の発送日、法人名、氏名が反映されて各シートが印刷されるようになっています。 右上の「反映」は変更を反映させるためだけなので無視して下さい。 ちなみに今の印刷するコードはネット上で拾ったもので、マクロについては書き方がよくわかりません。 Sub 請求書() For Each myCC In Selection Sheets("請求書").Range("I1").Value = Range("B" & myCC.Row).Value Sheets("請求書").Range("A3").Value = Range("C" & myCC.Row).Value Sheets("請求書").Range("A2").Value = Range("A" & myCC.Row).Value Sheets("請求書").Range("A4").Value = Range("D" & myCC.Row).Value Sheets("請求書").PrintOut Next End Sub よろしくお願い致します。
- 締切済み
- オフィス系ソフト
- エクセル マクロの設定方法について
差込印刷でSheet1に作成した名簿データにより、sheet2に作成しているデータへ差込印刷をしています。現在、次のようなマクロを組んで名簿の件数に合わせて、For ＝ 2 To 500 Step 8を修正しながら、印刷しています。できたら、名簿の件数の増減に関係なく印刷できるようになればと考えています。始めたばかりのマクロ初心者です。よろしくご教授ください。お願いします。 Dim i As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 ＝ sheets(″sheet1″) Set ws2 ＝ sheets(″sheet2″) For i ＝ 2 To 500 Step 8 ws2 .Range(″A1″).Value ＝ ws1.Cells(i+1,2).Value ws2 .Range(″A7″).Value ＝ ws1.Cells(i+2,2).Value ws2 .Range(″A13″).Value ＝ ws1.Cells(i+3,2).Value ws2 .Range(″A19″).Value ＝ ws1.Cells(i+4,2).Value ws2 .Range(″F1″).Value ＝ ws1.Cells(i+5,2).Value ws2 .Range(″F7″).Value ＝ ws1.Cells(i+6,2).Value ws2 .Range(″F13″).Value ＝ ws1.Cells(i+7,2).Value ws2 .Range(″F19″).Value ＝ ws1.Cells(i+8,2).Value DoEvents ws2.PrintOut Next End Subws2 .Range(″F1″).Value ＝ ws1.Cells(i+5,2).Value ネット等で調べて、上記のようなマクロで作業してます。（マクロの設定方法が間違っているところがあると思いますが？）
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロ検索について
みなさんはじめまして。 先日より必要に駆られてエクセルのマクロを使い始めた初心者です。 なかなか独学ではうまくいかず、 皆さんのお知恵を拝借したくお願いします。 したいことは以下の通りです。 検索シートに検索会社を入力すると、一部でも一致するデータを 顧客データが入った別シートから検索し、 検索シートにリストアップすると言うことがしたいです。 データシートには Ａ列 Ｂ列 Ｃ列 Ｄ列 Ｅ列 Ｆ列 分類 会社名 担当者 電話番号 詳細へハイパーリンク 業務内容 ---- ●社 Ａさん 123-4567 ****** XXXX ---- ×社 Ｂさん 234-5678 ****** ???? ---- △社 Ｃさん 345-6789 ****** !!!!! などのようにデータが300社くらい入っています。 一応自分で下記のようなマクロを組んでみたのですが、 リストアップされたデータのハイパーリンクの部分が文字列になってリンクとして使えません。 解消方法、またはもっと良いマクロがあれば教示お願いします Sub 検索() Dim tmp As Range Dim y As Integer, a, firstAddress '***** 結果を表示する部分をクリアします Sheets("検索").Range("A7:ag65536").ClearContents '***** キーワードを取得 a = InputBox("検索会社名を入力してください") '***** キーワードを含むデータを検索 Set tmp = Sheets("検索元データ").Columns(3).Find(a, , , xlPart) If tmp Is Nothing Then '***** 見つからない場合 MsgBox "一致するデータはありません" Else '***** 見つかった場合 firstAddress = tmp.Address y = 7 '***** 他にもあるか探してあれば記載 Do Sheets("検索").Range("c" & y) = tmp Sheets("検索").Range("b" & y) = tmp.Offset(0, -1) Sheets("検索").Range("d" & y) = tmp.Offset(0, 1) Sheets("検索").Range("e" & y) = tmp.Offset(0, 2) Sheets("検索").Range("f" & y) = tmp.Offset(0, 3) Sheets("検索").Range("g" & y) = tmp.Offset(0, 4) Sheets("検索").Range("h" & y) = tmp.Offset(0, 5) Sheets("検索").Range("i" & y) = tmp.Offset(0, 6) Sheets("検索").Range("j" & y) = tmp.Offset(0, 7) Set tmp = Sheets("検索元データ").Columns(3).FindNext(tmp) y = y + 1 Loop Until tmp.Address = firstAddress End If End Sub
- ベストアンサー
- オフィス系ソフト
補足
早々に回答ありがとうございます。 〉ただしどこにも空きが無い場合にはどうするのか 今のところどこか（１７か１８）が開いている状態です。 〉rngFC.Offset(0, 17).Value の１７のところを１５～１８まで変化させてIF文で判定。 これでいいのでしょうか？ご教授をお願いします。 IF rngFC.(xlCellTypeBlanks).Select Then rngFC.Offset(0, 15:18).Value = "手作業発行" End IF