• 締切済み

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

みんなの回答

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.4

再度の登場、onlyromです。 残念ながら、まだまだ情報が不足です。(^^;;; ●営業A,営業B,営業C、以下か必要分の表があると仮定して (1)「シート売上」と「シート請求書」は     ■同じブック■ではなくて、本当に■別々のブック■なのか (2)「シート売上」の「営業A」と表中の「担当項目」の「A」はどういう関係か (3)「シート売上」の「営業A」「営業B」「営業C」の表のレイアウト      (1)それぞれの表の開始行や列番号      (2)「営業A」が入っているセル番地      (3)表の見出しの行番号      (4)データの開始行 (4)「営業A]のデーターを追加していくうちに「営業B」の表に重なることはないのか (5)「シート請求」のレイアウト (苦情?) 「営業A」「営業B」とも全く同じデータの例を挙げては見る方は余計なことまで考えなければいけないので、 例を提示するときは、そこらを勘案して(実際のデータに沿ったものを)提示するべきです。   これくらいの情報があると回答が多々寄せられるでしょう。 -------------------------------------------------------------------------- それから「シート売上」の表の作り方はあまり感心しません。    営業_売上_担当_利益 このようにしておけば、請求書からのデータも転記しやすいし、後から集計表作成などデータ加工がし易いと思うのですが。。。  

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.3

説明がし易いように代入される側のシート名を仮に「集計表」とします。 でやりたいことは、 集計表の「最終行+1」の行に、請求書から値を代入したいということですか? そして、集計表にはデータが代入されていないセルにも式だけはセットされているんですね。 なら、 mycount = Range("B111").CurrentRegion.Rows.Count これで最終行はとれません。 例えば、集計表の式の入っていない列をB列とし、 この列で最終行が分かるとした場合 >mycount = Range("B111").CurrentRegion.Rows.Count >Cells(111 + mycount, 2).Select これを mycount = Cells(Rows.Count,"B").End(xlup).Row Cells(mycount+1, 2).Select 実際はそのたびにSelectは不要ですが今回はそのままで。。。 勘違いでしたらご容赦! ●質問するときは何をやりたいのかも少し具体的にしたほうがいいでしょう。 以上。

moni825
質問者

補足

ご回答ありがとう御座います。 本当に勉強になります。 今回やりたいことは 請求書に入力された値を営業のシートに連動させたいのです。 その際一番下の行にデータを追加し、なおかつ担当営業の表が同じシート内に人数分縦に並んでいる状況です。 book1 "シート売上" 営業A -----------------------------   | 売上 | 担当| 利益 | ----------------------------- 企業A| \1200 | A | \300 | 企業B| \2000 | A | \400 | 企業C| \3500 | B | \500 | 営業B -----------------------------   | 売上 | 担当| 利益 | ----------------------------- 企業A| \1200 | A | \300 | 企業B| \2000 | A | \400 | 企業C| \3500 | B | \500 | book2 "請求書" ------------------------------ 企業名| 手入力 ------------------------------ 売上 | 手入力 ------------------------------ 担当 | 手入力 ------------------------------ 利益 | 手入力 |更新| 更新ボタンを押した時、担当営業がAだった場合Aの表の一番下にデータを追加してくという風にしています。

  • suz83238
  • ベストアンサー率30% (197/656)
回答No.2

数式が入っていても入ってなくても関係ありません。 もしかしてOffset値が間違ってませんか? Cells(111 + mycount, 2).Selectの後に MsgBox ActiveCell.Address を表示させて、アドレス値を見て下さい。そこが、Offsetの基準になります。 ActiveCell.Offset(0, 0).Value には、 ActiveCell.Addressのアドレスに 値が入ります。

moni825
質問者

補足

ご回答ありがとう御座います。 早速確認してみた所、offset値は合ってました。 offsetの基準になる場所に値も入っていたので、大丈夫だと思います。 CurrentRegionがダメなんでしょうか?? お手数お掛けします。

  • htmcr
  • ベストアンサー率36% (11/30)
回答No.1

こんにちは。 wb1.Range("XXX").Value をすべて wb1.Range("XXX").Formula に置換してみてください

moni825
質問者

補足

早速の回答ありがとう御座います。 教えて頂いた通りやってみたところ、失敗でした 本当に申し訳ないです。 値だけを持ってきて貼り付けたいと思っています。 宜しくお願いいたします。

関連するQ&A

  • 行方向の同じ値のセルを結合するマクロ

    ネットで色々調べながら、A列方向の同じ値のセルを結合させるマクロ を作ってみたのですが、もっと簡単にできるようでしたら教えていただきたいです。 どうぞよろしくお願いいたします。 Sub セル結合() Dim r As Integer '行数 Dim i As Integer 'カウンタ r = Sheets(1).Range("a1").CurrentRegion.Rows.Count - 1 Application.DisplayAlerts = False For i = 1 To r Cells(i, 1).Activate '項目の一つ下のセルをアクティブに If ActiveCell.Value = ActiveCell.Offset(1).Value Then Range(ActiveCell, ActiveCell.Offset(1)).Merge End If Next Application.DisplayAlerts = True End Sub

  • EXCEL VBA

    EXCEL VBAで空白行が現れたら「小計」の文字を入力したいと思い以下のように記述しましたが、うまくいきません。どこがおかしいのか教えてください。 宜しくお願いします。 Sub write小計() Dim i As Integer Dim rowcnt As Integer rowcnt = Cells(1, 1).CurrentRegion.Rows.Count Range("B1").Select For i = 1 To rowcnt If Cells(i, 2).Value = "" Then Value = "小 計" ActiveCell.Offset(1).Select Next i End Sub

  • エクセルVBAでの関数

    下記、コードでセルに関数を入れるようにしてるのですが 関数で得られた値をセルに反映されるようにしたいのですが Dimを使用してもどう指定してよいのかわからず苦戦しております。 宜しくお願い致します。 Range("F1").Select Do Until ActiveCell.Offset(0, -1).Value = ""       With ActiveCell .FormulaR1C1 = "=MID(RC[-1],2,3)" .Offset(1, 0).Select End With Loop Range("A1").Select Do Until ActiveCell.Offset(0, 2).Value = "" With ActiveCell .FormulaR1C1 = "=RC[11]&RC[5]&Rc[8]&rc[9]&rc[3]" .Offset(1, 0).Select End With Loop

  • エクセルVBAで、複数のブックからデータベースを作りたい

    こんにちは。VBAをはじめたばかりの者です。 変数の使い方で教えていただきたいことがあります。 Dim myFLName As String myFLName = ThisWorkbook.Path & "\001.xls" Workbooks.Open Filename:=myFLName, ReadOnly:=True Workbooks("dbase.xls").Activate Range("A2").Select ActiveCell.Value = 1 ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R3") ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("C2") ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R2") ActiveCell.Offset(1, -3).Select 001.xls~(連番でない)200.xlsくらいまでのファイルがあり、 同じフォルダにdbase.xlsを作って1ブックから1レコードになるようにしたいと 思います。 こんな感じで1行目はできたのですが、2行目の1列目に「2」を入れ、 2列目からは001.xlsの次のブックを開いてセルの中身をコピーしたいのです。 変数の使い方がよくわからないのですが、教えていただけますでしょうか。 よろしくお願いいたします。

  • CheckBoxとTextBoxの値を貼付る方法

    よろしくお願いします。 Dim n As Long Dim r As Range Dim C, buf As String n = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & n).Select For Each C In Controls If TypeName(C) = "CheckBox" Then If C.Value Then buf = buf & C.Caption & vbCrLf End If Next C ActiveCell.Offset(-1, 16).Value = buf & TextBox9.Value ’buf=チェックされている複数のCheckBoxのCaption ’この時のActiveCell.Offset(-1, 16).ValueにはbufとTextBox9の値も表示されています。 End If で、セルに入力して ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(-1, 16).Value で、セルに貼り付けようとすると、bufの値のみ表示されてTextBox9の値が表示されません。 bufの値とTextBox9の値と両方をコピー表示する方法をお教えください。

  • エクセルのVBAコードにつてい

    以下のコードについて、その内容をまだ自分の知識では理解できず困っておりまして、アドバイスいただければと思いまして書き込みました。 『コード』 Sub Test() Dim Lc As Integer Dim Ct As Integer Dim MyR As Range Dim C As Range Dim D As Range Lc = Range("A1").End(xlToRight).Column - 2 For Each C In Range("B2", Range("B65536").End(xlUp)) Ct = WorksheetFunction.Count(C.Offset(, 1).Resize(, Lc)) If Ct > 0 Then Set MyR = C.Offset(, 1).Resize(, Lc).SpecialCells(2, 1) For Each D In MyR With Sheets("Sheet2").Range("A65536").End(xlUp) .Offset(1).Value = C.Value .Offset(1, 1).Value = Cells(1, D.Column).Value End With Next Set MyR = Nothing End If Next With Sheets("Sheet2") .Columns("A:B").AutoFit .Activate End With End Sub 『質問』 1.「Lc = Range("A1").End(xlToRight).Column - 2」の部分の解釈は「A1から右方向に一番最後のセルまでを範囲指定し、その一番右のセルの列番号を取得する」変数という解釈でいいのか 2.「Ct = WorksheetFunction.Count(C.Offset(, 1).Resize(, Lc))」の部分の変数はどういった値の整数を取得する変数なのか 以上2点についてアドバイスいただけると幸いです。

  • ブック内に特定名のシートがある場合

    はじめまして、こんにちは。 VBAを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With End Sub

  • VBAの連番の振り方について

    セルC1からC10まで罫線の表があり、inputboxで入力された数値だけD列以降にコピペされ、 セルC1をスタートに C1が1、D1が2、E1が3・・・といったように、連番を振りたいのですが、 下記プログラムで実行すると、inputboxで入力された数値分、表はコピペされますが、 肝心な連番が振られず1行目は空白のままになってしまいます。 ------------------------------------------------------------------------------ Dim cp As Long, x As Integer Dim ren As Integer 答え1 = InputBox("拠点数を入力してください。", "拠点数入力") ia = Val(答え1) Application.ScreenUpdating = False Range("C1:C10").Copy For cp = 1 To ia - 1 Cells(1, x + 4).PasteSpecial x = x + 1 Next With Application .CutCopyMode = False .ScreenUpdating = True End With ren = 1 Range("C1").Select Do While ActiveCell.Offset(0, 1).Value <> "" ActiveCell.Value = ren ren = ren + 1 ActiveCell.Offset(1).MergeArea.Select Loop どう修正すれば良いのか分かりません。 宜しくお願い致します。

  • VBAが止まります。

    皆さん、いつもありがとうございます。 下から14行目の『 objMail.Attachments.Add asrs1』で止まってしまします。 下から14行目の『 objMail.Attachments.Add asrs1』で止まってしまします。 asrs1をadrs1へ修正したりしましたが、改善されません。 昨日まで動いたいたのですが。 皆様、修正方法を教えていただけますでしdょうか。 ------------------------------------------------------- Sub メール作成() Dim objOutlook As Outlook.Application Dim objMail As Outlook.MailItem Dim wsMail As Worksheet Dim filead As String Dim tenp1 As String Dim tenp2 As String 'メール立ち上げ Set objOutlook = New Outlook.Application Set wsMail = ThisWorkbook.Sheets("リスト") '添付ファイルのアドレスを変数にする filead = Worksheets("リスト").Range("B3").Value '共通添付データのアドレスを読む tenp1 = filead & "\" & Worksheets("リスト").Range("B4") tenp2 = filead & "\" & Worksheets("リスト").Range("B5") Dim kobetsumail1 As String Dim kobetsumail2 As String Dim adrs1 As String Dim asrs2 As String '変数iを設定。最初は1 Dim i As Long i = 1 '送付前の確認メッセージ Dim rc As Long rc = MsgBox("記載に誤りが無いことを確認しましたか?", vbYesNo + vbQuestion, "確認") If rc = vbNo Then MsgBox "中断しました" End End If '基準となるセルを選択 Worksheets("リスト").Select Range("B7").Select '取引先名が書かれているB列が空欄になるまで続ける Do Until ActiveCell.Offset(i, 0).Value = "" '送付チェック欄が○なら作業を続ける If ActiveCell.Offset(i, 2).Value = "○" Then Set objMail = objOutlook.CreateItem(olMailTtem) '個別メールのデータ名称を読む Dim CC12(1) As String CC12(0) = ActiveCell.Offset(i, 6).Value CC12(1) = ActiveCell.Offset(i, 8).Value 'メールを作成する With wsMail objMail.to = ActiveCell.Offset(i, 4).Value objMail.CC = Join(CC12, ";") objMail.Subject = Range("B1").Value objMail.Bodyformat = olFormatPlain objMail.body = Range("B7").Offset(i, 0) & vbCrLf & Range("E7").Offset(i, 0) & "様" & vbCrLf & vbCrLf & Range("B2").Value & vbCrLf & vbCrLf kobetsumail1 = ActiveCell.Offset(i, 9).Value asrs1 = filead & "\" & kobetsumail1 kobetsumail2 = ActiveCell.Offset(i, 10).Value asrs2 = filead & "\" & kobetsumail2 If Range("B4").Value <> "" Then objMail.Attachments.Add tenp1 End If If Range("B5").Value <> "" Then objMail.Attachments.Add tenp2 End If If ActiveCell.Offset(i, 9).Value <> "" Then objMail.Attachments.Add asrs1 End If If ActiveCell.Offset(i, 10).Value <> "" Then objMail.Attachments.Add asrs2 End If objMail.Display objMail.Save End With End If i = i + 1 Loop Set objOutlook = Nothing MsgBox "下書きに保管しました" End Sub

  • excel vbaについてです

    VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)