VBAで内容を抽出させてコピーする方法
- VBAを使用して、エクセルの特定の条件に基づいてデータを抽出し、別のシートにコピーする方法を教えてください。
- 質問者はプログラムやコピーの方法について困っており、シート1の勤務体制とシート2の特定の条件に基づいてデータをコピーする方法が欲しいとしています。
- また、シート3にも同じようなコピーをする必要がある場合、その方法についても知りたいとしています。
- ベストアンサー
助けてください。 VBAで内容を抽出させてコピーする方法
助けてください。プログラムが苦戦しており全くわからずで困っています。まずエクセルのシート1に以下のような表があります。 (シート1) A B C D 1 名前 勤務体制 2 佐藤 夜勤務 3 鈴木 昼勤務 4 田中 昼勤務 5 小林 夜勤務 6 遠藤 変則勤務 7 松田 夜勤務 それでシート2では勤務体制を打つ欄がありまして(A1セル)、 その欄にたとえば『夜勤務』と打ったら以下のように シート1のB列にあったものを判別してA列の内容をシート2へコピー したいのです。(先頭 B2セル)(シート2のB~Dはマージセルなので値のみのコピーでいいのですが・・・) (シート2) A B C D 1 夜勤務 2 佐藤 3 小林 4 松田 なんとかこれを作成させたいのですが、何日もこれで悩みプログラムができない状態なので、みなさんのお力をかしていただけないでしょうか? お願いいたします。助けてください。 もしわかればでいいのですが、コピーの数が10個を超えましたら、 超えた分はシート3にも同じ欄で同じ形の表がありますので、 そちらにコピーさせたいのですが、可能なのでしょうか? もしわかればでいいですので・・・m(_ _)m プログラムを教えて頂けたら本当に幸いです。 こんな私にお力を貸して頂けないでしょうか?
- isa_isa
- お礼率24% (57/232)
- Visual Basic
- 回答数7
- ありがとう数3
- みんなの回答 (7)
- 専門家の回答
質問者が選んだベストアンサー
kopepeです。 13個ずつですと 1番 2番から14番 15番から27番 28番から40番となるかと思いますので、それで記載します。 iCnt = 0 iGyo = 1 iCol = 2 ' 2列目に固定 Do While Sheet1.Cells(iRow, 2) <> "" If Sheet1.Cells(iRow, 2) = sData Then Select Case iCnt Case 1 ' 1番がおわった後ということで2番になったら Sheet3.Activate ' シートを変える iGyo = 1 ' 複写する行をリセットします Case 14 ' 14番のあと、つまり15になったら(繰り返し) Sheet4.Activate iGyo = 1 Case 27 Sheet5.Activate iGyo = 1 End Select iGyo = iGyo + 1 ' ここでインクリメントすると、初期値が1なので2行目から始まる Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) iCnt = iCnt + 1 End If iRow = iRow + 1 Loop これなら、15個ずつでも29個ずつでも対応できると思います。 Case の数値を何番の後かという事に設定すればよいからです。 最初が0なのでわかりにくいかも知れませんが、当初は余りを使用していたためこのようになりました。 また、シート数が増えても少しの変更で可能です。 今回はテストしてないので、もしかしたら記載ミスがあるかも知れませんが、エラーの内容で判断すれば解決できると思います。
その他の回答 (6)
- kopepe
- ベストアンサー率50% (1/2)
kopepeです。 最初の1個だけはF4かも知れないしAA5かも知れないと言うことでしたので#5のような記述になったのですが、意味が図りかねています。 つまり、 1番はシート2のB2、 2番から10番までがシート3のB2からB10 11番から20番はシート4のB2からB11 21番から30番はシート5のB2からB11 という意味でしょうか。 もしそうなら Do While Sheet1.Cells(iRow, 2) <> "" If Sheet1.Cells(iRow, 2) = sData Then If iCnt = 1 Then Sheet3.Activate '2番目からシートをかえる If iCnt = 10 Then Sheet4.Activate ' 10になったら更にシートを変える ' 先ほどよりシートが繰り越されている iGyo = iCnt Mod 10 + 2 '-------------------------- B2の場合。 '------------------------------F4なら4,6 AA5なら5,27 If iCnt = 0 Then iGyo = 2 iCol = 2 End if '------------------------------ Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) iCnt = iCnt + 1 End If iRow = iRow + 1 Loop もし最初の1個をAA5にして、1から10まではシート2のまま 11からシート3に移るというのでしたら、 2番目からシートをかえるという行は削除し、 10になったらSheet3として、 iGyo = 5 iCol = 27 とします。 私の理解が正しかったでしょうか。
補足
本当にすべてが参考になります。一気に知識が上がったような期がします。 こういうことです。 つまり、 1番はシート2のB2 それから以降はふつうに13個筒(最後の変更ですm(__)m)ですので 2番から14番までがシート3のB2からB14 15番から28番はシート4のB2からB14 29番から41番はシート5のB2からB14 という意味です。 間違いなくシート5以上は存在しません。
- kopepe
- ベストアンサー率50% (1/2)
kopepeです 変動する条件がわかっていれば対処は出来ますが、 あらかじめ分かっていないとファジーな対処は私には出来ません。 このような方法はいかがでしょうか Dim iCol As Integer と宣言しておく事にします。 ここからが条件分岐 Select case (条件) Case (ケース1) iCol = (列番号) iGyo = (行番号) Case (ケース2) iCol = (列番号) iGyo = (行番号) Case (ケース3) iCol = (列番号) iGyo = (行番号) ....... Case Else iCol = (列番号) iGyo = (行番号) End select Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) とする方法です。 (条件)は、状況を表す文字なり数値を格納したセル等を指定します。 たとえばシート1のD1あたりに、「緊急招集」とか「お花見」とかの条件を入れます。 (ケース)は、それらの分岐内容です。 たとえば、「ほろ酔い」とか「弁当がまずい」とかです。 2つ3つの条件が複合して有る場合は、更にケースの中でIFやSelectCaseを入れ子にして作成します。 変動する条件がわかりませんので具体的ではないのですが、 SelectCaseのヘルプを参考にしてみて下さい。
補足
お早い回答うれしいです。では変動する条件としてこうしました? シート2には (シート2) A B C D E 1 夜勤務 2 佐藤 3 という風に一個だけ入れることにしました。 それでシート3、シート4以降は固定の (シート3) A B C D E 1 2 小林 3 松田 4 という風にB2~10個分をいれるようにしました。 これではどうでしょうか?また十個を超えればシート4に行くという感じです。 最初の1個だけはシート2のB2にいれるということはできないでしょうか? お願いいたします。m(_ _)m 何度も何度もすいません。本当にすいません。
- kopepe
- ベストアンサー率50% (1/2)
kopepeです。 複写開始行が1行目になったと理解して回答します。 iGyo = iCnt Mod 10 + 2 ' 対象の数を10で割った余りを出し、行数を指定 の行は iGyo = iCnt Mod 10 + 1 とします。これで1行目から開始します。 次に1行目の時だけE列、あとはB列にする方法です。 If iGyo = 1 Then Cells(iGyo, 5) = Sheet1.Cells(iRow, 1) Else Cells(iGyo, 2) = Sheet1.Cells(iRow, 1) End if 他には Dim iCol As Integer と宣言しておき If iGyo = 1 Then iCol = 5 Else iCol = 2 Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) とする方法もあります。 もしシート3以降は2行目から始まるのでしたら If iGyo = 1 Then iCol = 5 Else iCol = 2 If iCnt >= 20 Then iGyo = iGyo + 1 Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) と間に1行入れてください。 これなら20以降、つまりシート3以降なら2行目から開始します。
補足
なんどもすいません。先ほどいったE1というのは場合によって変動するかもしれないので、複写開始行が1行目になったというわけではないのです。なのでF4かもしれませんしAA5になるかもしれないのです。2個目以降は先ほどいった固定なのですが・・・。 なので1個に現れたのだけ特定位置にコピーできれば幸いなのですが・・ kopepeさんに何度も回答いただいてうれしく思っていますが、 もうkopepeさんしか解決お願いできる人がいないので なんとかならないでしょうか? 助けてください。 期限がせまっていまして・・。
- kopepe
- ベストアンサー率50% (1/2)
#2のkopepeです。 Sheet1と記載されているシート名は、タブの名前と同じでない可能性があります。 VisualBasicEditorで Sheet1(Sheet1) Sheet2(Sheet2) Sheet3(Sheet3) となっているか確認してください。 場合によっては Sheet2(Sheet1) Sheet1(Sheet2) Sheet3(Sheet3) となっていたりするケースもあります。 タブの名前を変更すると、たとえば Sheet1(たぶ1) Sheet2(みみたぶ2) Sheet3(たぶん3) のように括弧内がタブ名になりますが、シート名は変わりません。 ですからアクティブにするシートを括弧の前のシート名にするか、 あるいは Sheets("みみたぶ2").Activate のようにタブ名を指定するかして、そのワークブックのシート構成にあうように変更してみてください。
補足
kopepeさん謎が解決しました。いわれた通りシート名が違っていました。 なんといったらよいかkapopoさんのおかげで、悩みが一気にとれていき 感動しています。なんとお礼をいったらよいか。。 それとkopepeさん本当に申し訳ないのですが、たとえば 夜勤務 と指定していくつかでてきますが、でてきたらシート2では (シート2) A B C D E 1 夜勤務 佐藤 2 小林 3 松田 4 という風にでてきた1個目だけ E1 に。 以下にでてきたものはさっきいった通りのB2~10個だけ、 10個以上はシート3へ。 これはできないでしょうか? 急きょやるないようが1個だけかわってしまったので。 1行目にでてきたのだけ E1にいれなければいけない状態になってしまいまして・・・・
- kopepe
- ベストアンサー率50% (1/2)
こんにちは。 いつもいろいろな人に助けてもらってますので、今回は恩返しに投稿します。 こんなので試してみてください。 Public Sub Sabori() Dim sData As String ' 対象とする勤務態勢用 Dim iRow As Integer ' シート1で検索するためのカウンタ Dim iCnt As Integer ' 対象が見つかったときのカウンタ Dim iGyo As Integer ' コピーするための行数を格納するため ' ------------------------------- sData = Sheet2.Cells(1, 1) ' シート1のA1にある文字列(対象とする勤務態勢) iRow = 2 ' 検索を始める行番号 iCnt = 0 ' VBAでは無意味だけど初期化 iGyo = 0 ' 同上 ' ------------------------------- Sheet2.Activate ' 複写する先をアクティブにする(この方法でシートを変えてゆくため) ' 別のもっとスマートな方法もありますが... ' ------------------------------- Do While Sheet1.Cells(iRow, 2) <> "" ' シート1に社員がいるだけ検索する If Sheet1.Cells(iRow, 2) = sData Then ' 勤務態勢が同じ人が見つかった場合 ===== ここから If iCnt = 10 Then Sheet3.Activate ' 10になったらシートを変える 'If iCnt = 20 Then Sheet4.Activate ' 20になったら更に次のシートに行く ' シートがあるだけ繰り返して入れておく ' 0から始まっているので、10は11人目になる iGyo = iCnt Mod 10 + 2 ' 対象の数を10で割った余りを出し、行数を指定 Cells(iGyo, 2) = Sheet1.Cells(iRow, 1) ' カレントシートのセルにデータを入れる iCnt = iCnt + 1 ' みつかった数をインクリメントする End If ' ====================================== ここまで iRow = iRow + 1 ' 検索する行をインクリメントし、次の行に移る Loop End Sub
補足
kopepeさん本当にご回答うれしい限りで泣きそうです。何日も頭を悩ませてたことが解決しそうなので! 一つだけ質問させていただいてもよろしいでしょうか? 実行するとシート2のマージセルにコピーされないでシート1にコピーされてしまうのですが、どこを変更すればシート2にコピーされるのでしょうか・・?
- porilin
- ベストアンサー率22% (142/632)
可能かと言えば可能ですというか簡単です。 ちゃんとコーディングしても良いのですが、誰かが先に答えたら労力無駄なのでコ-ディングのヒントだけ。 VBAですよね? シート2のA1に入力でキックする様にしてA1の内容を変数に入れ 参照値=cells(1,1).value シート1のB1から順番に見てゆきます。 sheets("シート1").select 縦位置 = 1 while cells(2,i)value > "" if 参照値 = cells(2,i)value then ****ここにシート2に転機するコーディング******* end if i = i + 1 wend if文の中にカウンタをつけて、10個書いたら次のシートに書く等を記述すれば 「シート3にも」も対応できます。 解答欄にベタ入力なので、細かい部分間違いがあるかもしれませんが流れはイメージしていただけますか? ちなみにシート2のA1はセレクトBOXにした方が入力楽です。
補足
本当にご回答うれしく思います!!m(_ _)m porilinさんご足労ありがとうございます。 私もこのイメージは自分の中でも考えついたのですが(カウンタをつける等勉強になりました)、実際のコーディングがやはりわからないところが多々あるため、できたらプログラムをお教え頂けると幸いなのですが;; もしporilinさんにお時間があればでいいのでお願いいたします。無理なお願いを少しでも聞いていただきまして本当にうれしい限りです。
関連するQ&A
- excel2000 vlookupその他のデータ検索、抽出の関数について
エクセルについての質問です。 A B C 1 ○ 佐藤 ■ 2 × 鈴木 3 ○ 後藤 4 △ 近藤 5 △ 小林 6 × 大山 7 △ 大林 8 × 小山 9 ○ 松田 のようなデータがあります。 この中で、■(つまり、C1セル)に、「○」の行にある、B列の文字を返したいのですが、■(つまり、C1セル)に =VLOOKUP("○",$A$1:$B$9,2) と入力し、C10セルまでコピーしても、うまく反映されません。 私がほしい結果としては、 ○ △ × 佐藤 近藤 鈴木 後藤 小林 大山 松田 大林 小山 という具合に抽出したいのです。 とても拙い説明で申し訳ございません。 私がほしい結果と致しましては、上述のとおりでございます。 vlookupとは別の、他の関数を使うべきなのでしょうか? とても困っております・・・。。 どうぞ救いの手を差し伸べてください・・・!!
- ベストアンサー
- 会計ソフト
- EXCELのVBAで連続コピーの方法をお願いします
1月 1日 2日 3日 4日 加藤 午前 午後 午前 午後 (A2セル B2 C2 D2 E2セルに書込み) 鈴木 午後 午前 午後 午前 (A3セル B3 C3 D3 E3セルに書込み) SHEET1にエクセルの表を作成した後にSHEET2のA1からコピーをしSHEET1のデータは消し、次に SHEET1に2月の表を作成した後にSHEET2の1月の最後の次にコピー(すなわちA4) 以後3・4・5月と連続してコピーしたいのです。ひとことで言いますと1月から作成したリストを連続で残して置きたいのです。 宜しくお願いいたします。 エクセルは2007 と2003両方でお願いします 表現が悪くてすいません
- 締切済み
- Windows Vista
- VBAプログラムを教えてください
Sheet1のA1セルに○と入力した時にSheet2のB2~B10セルのデータをSheet1のA2~A10セルにコピーするプログラムを教えてください。
- ベストアンサー
- Visual Basic
- EXCEL VBA コピーしたシートへ値をコピペ
選択対象シート数は4つで、シート名は、「101」「102」「103」「104」とします。 シート名「表紙」のA列のセルはA10:101 A11:102 A12:103 A13:104となっており、 使用者はとなりのB10~B14セルに「○」「×」を入力規則から選択します。 また、シート名「表紙」のB6セルには製造番号(例:AM01-130012)を入力しておきます。 「○」となっているシートのみ選択して、下記マクロにてコピーを作成します。 コピーしたシートすべてのB2セルに製造番号を入力します。 ここまではできていて、下記のプログラムを追加したいのですが、うまくいきません。 さらに、○を付けたのと同じ行のD10~L10、D11~L11、D12~L12、D13~L13セルに、 使用者が文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。 文字列があれば、○を付けてコピーした対応するシートの中のH3~P3セルへ貼り付けたいのです。 D10、D11、D12、D13セルが空白のときは何も処理は行わないとします。 たとえば、下記のようにB12セルが○で、D12セルに文字列があれば、 D12~L12セルの値を、コピーで作成したシート103の中のH3~P3セルへ貼り付けたいのです。 B11セルも○ですが、D11セルに文字列がないのでシートのコピーだけ行います。 アドバイスいただけると助かります。 VBA初心者で申し訳ございませんが、よろしくお願いいたします。 <表紙のシート> A B C D E F G H I J K L 5 6 AM01-130012 7 8 9 10 101 × 11 102 ○ 12 103 ○ A1-1 A1-2 A1-3 A1-4 A1-5 A1-6 A1-7 A1-8 A1-9 13 104 × <プログラム> Sub TestSample() If Application.CountIf(Worksheets("表紙").Range("B10:B17"), "*○*") = 0 Then MsgBox "部品番号が選択されていません。" Exit Sub End If Dim 製造番号 As String 製造番号 = Range("B6").Value Dim c As Range Dim flg As Boolean On Error Resume Next flg = True ThisWorkbook.Activate On Error GoTo ErrOut_ For Each c In Worksheets("表紙").Range("B10:B13") If c.Value Like "○*" Then Worksheets(c.Offset(, -1).Text).Select flg flg = False End If Next c If Not flg Then ActiveWindow.SelectedSheets.Copy ' コピーしたすべてのシートに製造番号を書き込む For Each 各シート In Worksheets With 各シート .Activate Cells(1, 2) = 製造番号 End With Next Exit Sub ErrOut_: MsgBox """表紙""シートに記載されたシート名" & c.Offset(, -1).Text & "は存在しません。, vbInformation" End Sub
- 締切済み
- Excel(エクセル)
- VBA 条件の一致する行の特定のセルの削除について
VBA初心者です。よろしくお願いします。 <sheet1> A B C D E 1 1 1211 佐藤 10 100 2 2 1344 山田 25 150 3 3 1522 田中 5 80 4 4 1655 高橋 35 200 ・ ・ 100 100 3682 小林 40 300 <sheet2> A B 1 1344 2 この様な表があったとします。(見辛くてすみません) "sheet2"A1セルに入力した内容と同じ内容を"sheet1"のB列から検索し、その行のB~Eのセルを削除するにはどのようにしたら良いでしょうか? 例えば"sheet2で"「1344」と入力した場合、"sheet1"の「1344」のある2行目のB~Eのセルを削除するといった感じです。 削除後の空白は詰める必要はなく、マクロを記録させるボタンは"sheet2"に貼り付けます。 色々調べましたがどうにも分からない為質問させていただきます。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセル 配列数式 #DIV/0!があると反映されない
話がややこしいかと思うのですが、宜しくお願いします。 以前に、「楽天みんなで解決」のビジネス&キャリアで質問させていただいたことに大して再び質問させていただきたいのです・・。 どうかお力を・・・!! 以前はこんな質問を致しました。 ーーーーーーーーーーーー エクセルについての質問です。 A B C 1 ○ 佐藤 ■ 2 × 鈴木 3 ○ 後藤 4 △ 近藤 5 △ 小林 6 × 大山 7 △ 大林 8 × 小山 9 ○ 松田 のようなデータがあります。 この中で、■(つまり、C1セル)に、「○」の行にある、B列の文字を返したいのですが、■(つまり、C1セル)に =VLOOKUP("○",$A$1:$B$9,2) と入力し、C10セルまでコピーしても、うまく反映されません。 私がほしい結果としては、 ○ △ × 佐藤 近藤 鈴木 後藤 小林 大山 松田 大林 小山 という具合に抽出したいのです。 ーーーーーーーーーーー この質問にたいする回答といたしまして、 ========== 一例です。 データをSheet1、Sheet2の1行目に記号があるとします。 Sheet2のA2に次の数式を入力して、縦横にコピーして下さい。 尚、配列数式の為、入力完了時にshift+ctrl+enterキーを同時押下して下さい。 =IF(COUNTIF(Sheet1!$A:$A,A$1)>ROW(A1)-1,INDEX(Sheet1!$B:$B,SMALL(IF(Sheet1!$A$1:$A$100=A$1,ROW(Sheet1!$A$1:$A$100),99999),ROW(A1))),"") ========== という回答を頂きました。 一度はこれで解決したのですが、今回また問題が発生してしまったのです。 「○」や「△」の記号や「定価」といった文字ではうまくいくのですが、【#DIV/0!】というエラー値が一個でも入ると、とたんにうまく反映されなくなるのです。 例:前述のデータ表に沿うとします。以下のようにA5セルにエラーが入ると、とたんに全部#DIV/0!となってしまいます。 A B 1 ○ 佐藤 2 × 鈴木 3 ○ 後藤 4 △ 近藤 5 #DIV/0! 小林 6 × 大山 7 △ 大林 8 × 小山 9 ○ 松田 <抽出後> ○ △ × #DIV/0! #DIV/0! #DIV/0! #DIV/0! #DIV/0! #DIV/0! #DIV/0! #DIV/0! #DIV/0! 大変困っております・・・。 自分で解決しようものにも、数式の意味が解読できませんでした。。配列数式とはなんぞや、括弧がたくさんあって意味がよくわからず・・。 解決方法をどなたかご教授を!! ついでに、なぜこのような現象がおきてしまうのか、できたら教えていただきたいです・・。
- ベストアンサー
- オフィス系ソフト
- コピー貼り付けのマクロの処理時間の早い方法を教えてください。
ある表の中から部分的にセルを指定して抜き出して、 別の表を作成しています。 コピーする範囲のセルが連続して繋がっていないので、 セルを一つづつ指定してコピーして貼り付ける動作をマクロの自動記録で登録しました。 コピー貼り付けの回数が100セル分ほどあるので、処理時間が遅いです。 目で見て順番にデータがコピーされて行くのが分かるくらいです。 この動作をもっと速くするマクロを教えてください。 実際の表ではコピー元(sheet1)のA5→コピー先(sheet2)C1、 以下同じくコピー元は全て(sheet1)でコピー先は(sheet2)です。 A8→C2、A11→C3、A14→C4、A17→C5,・・・・ B2→D1、B12→D2、B22→D3、B32→D4,・・・・ このような感じでコピーします。 *コピー元のsheet1の指定セルは毎回同じ場所です。 コピー先も毎回同じセルです。 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- sheet1から抽出しsheet2へコピーをVBAで
VBA初心者です。色々本など見たのですがどうして良いか判らず質問させて頂きます。 sheet2のA1にデータを入力したら、sheet1のA列に同じデータがあるかどうか探してある場合は、その行をsheet2の6行目からコピーをさせたいのですが、 (1)sheet1のデータは下に追加していきます。 (2)sheet2のデータ貼り付けは詰めて貼り付けていきたい。 sheet1 A B C 1 - - - 2 - - - 3 - - - 4 社名 商品名 入荷数 5 A社 ○ 10 6 B社 △ 5 7 C社 ■ 20 8 A社 × 30 9 D社 ○ 10 ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ sheet2 A B C 1 A社 - - 2 - - - 3 - - - 4 - - - 5 社名 商品名 入荷数 6 A社 ○ 10 7 A社 × 30 ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ -はブランクセル 色々試したのですが、sheet2にコピーはされてもブランクの行が詰まらないなど上手くいかないため教えて頂きたく質問させて頂きました。 宜しくお願いいたします。
- 締切済み
- オフィス系ソフト
- エクセルのセルの内容を2つのセルに分けてコピーする
わからないので質問します。。 シート1に 1 A B C 2 1.3 - 1.6 と、たとえばコピーしたい場合に シート2に 1 A 1.3 - 1.6 (Aの一つのセルに書いてある。) とある場合に「-」を境にして、シート1のA,B,Cのセルに 分けてコピーすることは可能でしょうか??? よろしくご教示願います<(_ _)>
- ベストアンサー
- オフィス系ソフト
- VBAにてデータを振り分けたい。
2つのシート(sheet1、sheet2)があり、sheet2に振分けるデータ(下表)を作成しておきます。 (列) A B C D (行) 1 山 川 地 空 2 ○ △ × □ 3 ア イ ウ エ (1)ユーザーフォームを作成し、その中にコンボボックスを作成して山を入力する。 山は、セルA1へ、川は、セルB2へ、地は、セルC3へ、空は、セルD1、それぞれ 決められたセルにコピーされる(すべてsheet1へコピー)。 (2)にコンボボックスにて○を入力する。○はセルA1へ、△は、セルB2へ、×は、 セルC3へ、□は、セルD1へ、それぞれ決められたセルにコピーされる(すべて sheet1へコピー)。 ちなみに(1)と(2)のコピーされるセルの位置は同じ場所です。 というようなものをExcelのVBAにて作成したいのですが、VBAは、まだよくわかりません。 出来れば、sheet1のセルに数式などを入力したくはないのですが...。 どうか皆様のご指導を宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
お礼
何回も大変ありがとうございました。なぞが解決しましたのでkopepeさんには数え切れないほどに感謝をしております。本当にありがとうございました。
補足
ご回等いただいてから返事が遅れてしまいすいませんでした。あれかたずっと徹夜でヒントをもとにプログラムを書いたりしてたのですが、どうしても解決できませんでした。kopepeさんのを上のプログラムで総合すると、以下のとおりになるのでしょうか? Public Sub Sabori() Dim sData As String ' 対象とする勤務態勢用 Dim iRow As Integer ' シート1で検索するためのカウンタ Dim iCnt As Integer ' 対象が見つかったときのカウンタ Dim iGyo As Integer ' コピーするための行数を格納するため ' ------------------------------- sData = Sheet2.Cells(1, 1) ' シート1のA1にある文字列(対象とする勤務態勢) iRow = 2 ' 検索を始める行番号 iCnt = 0 ' VBAでは無意味だけど初期化 iGyo = 0 ' 同上 ' ------------------------------- 'Sheet2.Activate iCnt = 0 iGyo = 1 iCol = 2 ' 2列目に固定 Do While Sheet1.Cells(iRow, 2) <> "" If Sheet1.Cells(iRow, 2) = sData Then Select Case iCnt Case 1 ' 1番がおわった後ということで2番になったら Sheet3.Activate ' シートを変える iGyo = 1 ' 複写する行をリセットします Case 14 ' 14番のあと、つまり15になったら(繰り返し) Sheet4.Activate iGyo = 1 Case 27 Sheet5.Activate iGyo = 1 End Select iGyo = iGyo + 1 ' ここでインクリメントすると、初期値が1なので2行目から始まる Cells(iGyo, iCol) = Sheet1.Cells(iRow, 1) iCnt = iCnt + 1 End If iRow = iRow + 1 Loop End Sub これで実行するとなぜかシート2のB2に1個、シート3からは13個づつとなるはずが、 シート2に13個張り付き、シート3以降に複写されません。 それでやはり、kopepeさんのお力をお借りしたく思い、もう一度 お願いしたいです。本当に何度もすいません。 助けていただけないでしょうか? 参考書を買ってきて、勉強中なのですが、わたしの知識がおいついてないのかもしれません。すいません。