advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 1215 for (Mook) (0.002 sec.)
[[20150404140303]]
#score: 9211
@digest: ea6a671b1b09fc51cfd9777af0474522
@id: 67695
@mdate: 2015-04-04T14:46:57Z
@size: 13232
@type: text/plain
#keywords: 加筆 (13747), transpose (8550), sh2 (8219), myrow (6672), worksheetfunction (5722), activecell (3659), sh1 (3656), ドボ (3334), ws1 (3333), 理番 (3040), 保護 (3004), xlpastevalues (2760), pastespecial (2685), range (2641), ト保 (2544), コマ (2444), 保存 (2247), 領域 (2094), マン (2063), ws2 (2050), sheet2 (1818), 土) (1803), 指示 (1785), スワ (1682), value (1605), 上書 (1565), entirerow (1558), 一行 (1529), 2015 (1459), worksheet (1410), paste (1404), ボタ (1271)
『一行を区切って数列にコピー』(さち)
お世話になります。 先日こちらで質問した時にいただいたアドバイスを元に、 別のものを作っていますが、途中から動かなくなってしまいました。 またお力を貸してください。 選択した一行のうち、数分割してコピーしたいのですが、 その指示がうまくできません。 Sheet1 A B C D E F G H I J K L М N O P・・・ あ い う か き く こ さ し せ そ た・・・ sheet2 A B C あ さ な い し に う せ ね そ の か た は き ち ・ く ・ ・ ・ ・ ・ ・ ・ ・ という感じに、長い一行を区切って別シートの列にコピーできるようにしたいです。 途中には空白セルもあります。 Private Sub コピー_Click() Rows(ActiveCell.Row).Copy Worksheets("sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True End Sub で、カーソルを置いた行を、一行まるごと列にコピーできましたが、 セル番号等を入れると動きません。 行を区切って列にコピーする指示の書き方を教えてください。 よろしくお願いいたします。 < 使用 Excel:Excel2013、使用 OS:Windows8 > ---- 二つ確認したいのですけれど、 ・区切るのは固定サイズなのでしょうか。 ・動かないというコードは提示できますか? (Mook) 2015/04/04(土) 14:46 ---- 区切るのは、シート1 A(通し番号),BーD,E-N,O-X,Y-AH,AI-AL シート2 A2,A3:A5,B2:B11,C2:C11,D2:D11,E2:E5 にコピーする 動かないコード Rows(ActiveCell.Row,"A").resize(11).Copy Worksheets("sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,_ SkipBlanks:=False, Transpose:=True Rows(ActiveCell.Row).Copyにあたる部分がどう書いても動かせません... WS1に頭書き →WS2にコピー+修正、加筆 →WS1の同じ管理番号の行に追加でコピーしてリスト完成→上書き保存 →WS1リストからWS2フォームへ呼び出し、修正、加筆→上書き保存 というループを作りたいのです。 シート2からシート1へコピーするマクロが以下です。 こちらが先にできました。 (シート1でアクティブにした行についての作業なので、 現在はシート1に保存ボタンを置いてあります) Private Sub 保存_Click() Dim WS2 As Worksheet Dim WS1 As Worksheet Set WS2 = Worksheets("sheet2") Set WS1 = Worksheets("sheet1") With ActiveCell WS1.Range("A1").Value = WS4.Cells(.Row, "A").Value Worksheets("sheet2").Range("A2:A5").Copy WS1.Cells(.Row, "A").PasteSpecial Paste:=xlPasteValues, Transpose:=True Worksheets("sheet2").Range("B2:B11").Copy WS1.Cells(.Row, "E").PasteSpecial Paste:=xlPasteValues, Transpose:=True Worksheets("sheet2").Range("C2:C11").Copy WS1.Cells(.Row, "O").PasteSpecial Paste:=xlPasteValues, Transpose:=True Worksheets("sheet2").Range("D2:D11").Copy WS1.Cells(.Row, "Y").PasteSpecial Paste:=xlPasteValues, Transpose:=True Worksheets("sheet2").Range("E2:E5").Copy WS1.Cells(.Row, "AI").PasteSpecial Paste:=xlPasteValues, Transpose:=True WS2.Range("A2:A5,B2:B11,C2:C11,D2:D11,E2:E5").ClearContents End With End Sub さらに追加したいこと WS1からマクロを走らせたらWS2を開く WS2からWS1のコマンドボタンを押して保存 シートを移動する際にページ先頭あたりにセルを戻す 保存の際、WS1に戻って保存しているため、どこかちがうセルを触ってしまうと データが消されてしまったりします。 WS1のA列(管理番号)がWS2のA2セルと同じだった場合のみ上書き保存 とした方が良いかも?と思っています。 日々改造奮闘中ですが、時間ばかりかかって進みません。 どうかよろしくお願いします! (さち) 2015/04/04(土) 17:09 ---- 要件もコードも読んでいませんが >Rows(ActiveCell.Row).Copyにあたる部分がどう書いても動かせません... コードとしては Rows(ActiveCell.Row,"A").resize(11).Copy ここのことですか? どんな領域をコピーしたいのかわからないのですが、Rows(ActiveCell.Row,"A") こんな領域指定はありません。 Cells(ActiveCell.Row,"A") か Rows(Activecell.Row) です。どちらが目的の領域かわかりませんが。 なお、後者なら ActiveCell.EntireRow という書き方もできます。 (β) 2015/04/04(土) 17:34 ---- >WS1に頭書き >→WS2にコピー+修正、加筆 >→WS1の同じ管理番号の行に追加でコピーしてリスト完成→上書き保存 >→WS1リストからWS2フォームへ呼び出し、修正、加筆→上書き保存 >というループを作りたいのです。 >さらに追加したいこと >WS1からマクロを走らせたらWS2を開く >WS2からWS1のコマンドボタンを押して保存 >シートを移動する際にページ先頭あたりにセルを戻す 一生懸命、やりたいことを理解しようとして繰り返し読んでいるのですが、わかりません。 同じ管理番号の行って? あらかじめ、Sheet2 には、何か書かれていて、そこのしかるべきところに Sheet1から転記? Sheet1 は1行目だけ?それとも何行もあり? 「頭書き」という意味も??? 「WS2からWS1のコマンドボタンを押して保存」?? Sheet2 を表示している状態で Sheet1 のコマンドボタンを押す? このSheet1のコマンドボタンには、どんなマクロが登録されているのかな? Private Sub 保存_Click() このコードは動いている?動いていない? ここで、いきなり登場する WS4 って何?? 等々、わからないところだらけですが。 いずれにしても、最初に提示のあった、Sheet1の1行目を Sheet2の複数の列に分割して転記するのは そちらのコードを正しくすればできるでしょうし、あるいは以下のようなコードでも。 Sub Test() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") sh2.Range("A2").Value = sh1.Range("A1").Value sh2.Range("A3:A5").Value = WorksheetFunction.Transpose(sh1.Range("B1:D1")) sh2.Range("B2:B11").Value = WorksheetFunction.Transpose(sh1.Range("E1:N1")) sh2.Range("C2:C11").Value = WorksheetFunction.Transpose(sh1.Range("O1:X1")) sh2.Range("D2:D11").Value = WorksheetFunction.Transpose(sh1.Range("Y1:AH1")) sh2.Range("E2:E5").Value = WorksheetFunction.Transpose(sh1.Range("AI1:AL1")) End Sub (β) 2015/04/04(土) 18:02 ---- >選択した一行のうち、数分割してコピーしたいのですが ここを見過ごしていました。 ↑のコードはボツにして以下。 (でも、きっと Sheet2側は固定領域ではなく、何かしら検索してその対象の領域に転記するんだろうね。ほんとは) Sub Test2() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim myrow As Range Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") sh1.Activate Set myrow = ActiveCell.EntireRow sh2.Range("A2").Value = myrow.Range("A1").Value sh2.Range("A3:A5").Value = WorksheetFunction.Transpose(myrow.Range("B1:D1")) sh2.Range("B2:B11").Value = WorksheetFunction.Transpose(myrow.Range("E1:N1")) sh2.Range("C2:C11").Value = WorksheetFunction.Transpose(myrow.Range("O1:X1")) sh2.Range("D2:D11").Value = WorksheetFunction.Transpose(myrow.Range("Y1:AH1")) sh2.Range("E2:E5").Value = WorksheetFunction.Transpose(myrow.Range("AI1:AL1")) sh2.Activate End Sub (β) 2015/04/04(土) 18:10 ---- もしかして 1.Sheet1でどこかの行を選択 2.Sheet2の「固定」の領域に転記 3.Sheet2側で加筆修正 4.加筆修正が終わったら、Sheet1 の該当の行に書き戻し こんなことをしたかったのかな? (β) 2015/04/04(土) 18:15 ---- もし、↑の勝手な想像通りだとすれば。 Sub Copy1To2() 'Sheet1 側のコマンドボタンに登録 Dim sh1 As Worksheet Dim sh2 As Worksheet Dim myrow As Range Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") sh1.Activate Set myrow = ActiveCell.EntireRow sh2.Range("A2").Value = myrow.Range("A1").Value sh2.Range("A3:A5").Value = WorksheetFunction.Transpose(myrow.Range("B1:D1")) sh2.Range("B2:B11").Value = WorksheetFunction.Transpose(myrow.Range("E1:N1")) sh2.Range("C2:C11").Value = WorksheetFunction.Transpose(myrow.Range("O1:X1")) sh2.Range("D2:D11").Value = WorksheetFunction.Transpose(myrow.Range("Y1:AH1")) sh2.Range("E2:E5").Value = WorksheetFunction.Transpose(myrow.Range("AI1:AL1")) Application.Goto sh2.Range("A1") End Sub Sub Back2To1() 'Sheet2 側のコマンドボタンに登録 Dim sh1 As Worksheet Dim sh2 As Worksheet Dim c As Range Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") Set c = sh1.Range("A1", sh1.Range("A" & Rows.Count).End(xlUp)).Find(What:=sh2.Range("A2").Value, LookAt:=xlWhole) If c Is Nothing Then MsgBox sh1.Name & " に " & sh2.Range("A2").Value & " が見つかりませんよ" Exit Sub End If With c.EntireRow .Range("A1").Value = sh2.Range("A2").Value .Range("B1:D1").Value = WorksheetFunction.Transpose(sh2.Range("A3:A5")) .Range("E1:N1").Value = WorksheetFunction.Transpose(sh2.Range("B2:B11")) .Range("O1:X1").Value = WorksheetFunction.Transpose(sh2.Range("C2:C11")) .Range("Y1:AH1").Value = WorksheetFunction.Transpose(sh2.Range("D2:D11")) .Range("AI1:AL1").Value = WorksheetFunction.Transpose(sh2.Range("E2:E5")) End With Application.Goto c End Sub 19:10 追記 保存はいれていません。どういうタイミングで保存が必要かを決めてもらえれば いかようにでも対応します。 (β) 2015/04/04(土) 18:30 ---- すごい...感動しました!! こんなにさくさく動くなんて! ありがとうございました。 言われたものを作るのに、調べてあれこれやってもできず、 そのうちに何をやっているんだか分からなくなりました。 シート1から2へ、2から1へ、移動する時にそれぞれのボタンで保存したいです。 シート1 A列には通し番号がついているので、 シート2 A2セルにも出したいです。 シート1、2とも一部ロックをかけてシート保護したいと思います。 ロックの解除、再ロックの指示(パスワード付き)もいれていただけますか? これを色々な人が触ることになるので、 誤作動?をなくすために(破壊すると直せないので)、 シンプルなもの、必要箇所以外は触れないようにしたいです。 どうぞよろしくお願いいたします! (さち) 2015/04/04(土) 20:25 ---- すみません! A列の通し番号、最初は "1" のままで止まって いたのですが、一度閉じてブックを開き直したら 連動していました。 ありがとうございます。 (さち) 2015/04/04(土) 21:21 ---- >A列の通し番号、最初は "1" のままで止まって > いたのですが、一度閉じてブックを開き直したら >連動していました。 実は Sub Copy1To2() 'Sheet1 側のコマンドボタンに登録 この中の、sh2.Range("A2").Value = myrow.Range("A1").Value 最初は、sh2.Range("A2").Value = sh1.Range("A1").Value のままにしていて ここだけは、1行目の値がSheet2に転記されてしまう、おばかなコードだったので こっそりと(?)sh2.Range("A2").Value = myrow.Range("A1").Value に変えたんです。 ちゃんと、説明して変えればよかったです。 で、シート保護解除とその再保護ですけど、VBA内でやりたいということは ・保護解除(1) ・マクロでいろいろシートに書き込み ・再保護(2) こんなことをやりたいからですね。 こうしてもいいですが、もう1つ、VBAには隠し技があります。 保護を掛けたまま、でも、VBAは、したい放題、なんでもできる。一々、(1)と(2)をやる必要がなくなります。 これが、UserInterface:=True付の保護です。 残念ながら、この設定は操作ではできず、VBAで行う必要があるのですが、一度、こう設定しておけば 自由自在にマクロで保護されたシートの変更ができます。 実際には、ブックを開いたときに設定するというのがよろしいかと。 該当のシートに、必要なシート保護条件でパスワード付保護を(手作業で)かけたうえで、 THisWorkbookモジュール(VBE画面のプロジェクトツリーのThisWorkbookをダブルクリック)に。 一度、ブックを閉じて、再度開いてください。 Private Sub Workbook_Open() '現在の保護要素を継承したシート保護 UserInterfaceOnly付 Dim pp As Protection Dim shn As Variant For Each shn In Array("Sheet1", "Sheet2") '★対象シート名。いくつでも。 With Sheets(shn) Set pp = .Protection .Protect DrawingObjects:=.ProtectDrawingObjects, _ Contents:=.ProtectContents, _ Scenarios:=.ProtectScenarios, _ AllowFormattingCells:=pp.AllowFormattingCells, _ AllowFormattingColumns:=pp.AllowFormattingColumns, _ AllowFormattingRows:=pp.AllowFormattingRows, _ AllowInsertingColumns:=pp.AllowInsertingColumns, _ AllowInsertingRows:=pp.AllowInsertingRows, _ AllowInsertingHyperlinks:=pp.AllowInsertingHyperlinks, _ AllowDeletingColumns:=pp.AllowDeletingColumns, _ AllowDeletingRows:=pp.AllowDeletingRows, _ AllowSorting:=pp.AllowSorting, _ AllowFiltering:=pp.AllowFiltering, _ AllowUsingPivotTables:=pp.AllowUsingPivotTables, _ UserInterfaceOnly:=True, _ Password:="abcd" '★パスワードは実際のものに End With Next End Sub で、ブック保存ですが、それぞれのマクロの最後の Application.Goto の上に ThisWorkbook.Save と入れてください。 (β) 2015/04/04(土) 21:53 ---- (β)様 ありがとうございました! 実際のデータに当てはめてみたら 見事に動きました。感動のひとことに尽きます。 細かい解説も書いてくださって、指示の意味が 素人にも少しだけですが分かりました。 VBAやマクロが分かったら仕事もすごく楽しくなるだろう 思います。 本当にありがとうございました♪ (さち) 2015/04/04(土) 23:46 ...
http://www.excel.studio-kazu.jp/wiki/kazuwiki/201504/20150404140303.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97014 documents and 608133 words.

訪問者:カウンタValid HTML 4.01 Transitional