Results of 1 - 1 of about 295 for cell filename (0.001 sec.)
cell (1170), filename (1981)
- [[20051201212008]]
- #score: 11170
- @digest: f896dd83aef8d6efa8b6f632bb6c0267
- @id: 18559
- @mdate: 2005-12-04T15:23:10Z
- @size: 9185
- @type: text/plain
- #keywords: intloopb (40403), mytsh (32951), mydsh (25703), iv30000 (20437), intloopa (19159), shcheck (18816), 十種 (16406), c5501 (15497), 何十 (5935), mysh (5696), copytorange (3420), advancedfilter (3193), xlfiltercopy (3160), action (3142), maxrow (3029), s1 (2853), criteriarange (2623), unique (2615), 弥太 (2508), null (2435), worksheets (2399), xlcelltypevisible (2387), lastrow (1916), sheets (1906), hatch (1629), screenupdating (1617), 見出 (1523), ーチ (1390), ◆ (1335), activate (1316), ト名 (1302), address (1054)
- 『データを別シートへ抽出』（みつ）
下表の1から5000のデータがSheet1にあります。A列のS1をSheet2へA列のS2をSheet3を抽出したいのですが、なかなかうまくいきません。現在はオートフィルタにて別シートへコピーしていますが時間がかかり過ぎてしまう為ご教授おねがいします。 A B C 1 S1 T8 1 2 S2 T8 2 3 S3 T5 3 4 S2 T5 4 5000 S50 T5 3 Sheet2 A B C 1 S1 T8 1 2 3 4 Sheet3 A B C 1 S2 T8 2 2 S2 T5 4 3 4 ---- ◆関数による方法です! ◆S1を抽出するシートのシート名を「S1」にします ◆シート「S1」 A B C D E F 1 S1 T8 1 S1 1 ◆E1の式 E1=REPLACE(CELL("FILENAME",A1),1,FIND("]",CELL("FILENAME",A1)),) ★シート名の「S1」は表示されます ◆F列を作業列に! F1=IF(Sheet1!A1=$E$1,ROW(Sheet1!A1),"") ★下にコピー ◆A1の式 A1=IF(ROW(A1)>COUNT($F:$F),"",INDEX(Sheet1!A:A,SMALL($F:$F,ROW(A1)))) ★右・下にコピー ◆S1の行が表示されているはずです! ◆S1のシートを作成します! ◆Ctrlを押しながら、S1のシート名タブを選択しで、右にドラッグします ◆シート「S1(2)」がコピーされます ◆シート名を「S2」に変更すると、S2の行が表示されたシートが作成されます ◆いかがでしょうか! （Maron) ---- ↓と同様に、フィルタオプションの設定を使う方法もあります。 [[20051201143119]]『行の上詰め抽出』 マクロの自動記録を利用して作成したものです。 なお、Sheet1の1行目には列見出しが A B C 1 見出し1 見出し2 見出し3 抽出条件はSheet1のE1:F2に E F 1 見出し1 見出し1 2 S1 S2 と記述しています。いかがでしょうか?(Hatch) Sub Macro1() Worksheets("Sheet2").Activate Columns("A:C").ClearContents Sheets("Sheet1").Range("A1:C5501").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Worksheets("Sheet1").Range("E1:E2"), CopyToRange:=Range("A1"), Unique:=False '--- Worksheets("Sheet3").Activate Columns("A:C").ClearContents Sheets("Sheet1").Range("A1:C5501").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Worksheets("Sheet1").Range("F1:F2"), CopyToRange:=Range("A1"), Unique:=False End Sub ---- マクロによる方法です (Hatch)さんの方法より遅い&ごちゃごちゃしてますが 例のごとく参考程度にこんなやりかたも・・・と Sheets1からFindを使って検索して一行ずつコピーしてます。 ヒット数が増えるともちろん処理時間も遅くなります。 下の部分でS1しか抽出できないので、S2はもう一つ作る必要があります。 Dim c As Range Dim e As Range Dim F_Address As String Application.ScreenUpdating = False Set e = Sheets("Sheet2").Range("A1") Sheets("Sheet2").Cells.Clear Set c = Columns(1).Find(What:="S1", After:=Range("A1"), LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) If Not c Is Nothing Then F_Address = c.Address Do Rows(c.Row).Copy e Set e = e.Offset(1) Set c = Columns(1).FindNext(c) Loop Until c Is Nothing Or c.Address = F_Address End If Application.ScreenUpdating = True PS:お急ぎでしたら回りくどくしてすいませんmm (Null) Maron様 Hatch様 Null様ありがとうございます。 Null様もう少し詳しく教えていただけませんかね。マクロで実行してみましたがうまくいきません。 ---- >Null様もう少し詳しく教えていただけませんかね。 >マクロで実行してみましたがうまくいきません。 何を教えてほしいのでしょうか? (アカギ) ---- Sheet1にデータを入れマクロ実行したがSheet2に何も表示されません（エラー表示もなし） ---- これってS1とS2だけを拾い出したいんでっか? S50が顔出しとるし、作業が面倒という事は何十種類かのデータをコピーしたいんと ちゃいまっか? 必要なだけシートを作成して試してみてくらはい。 せやけど、何十種類もあるんやったらシート名をS1とかS2とかにしとく方が利便性に 長けてますわなぁ。 もしそうならSheets("sheet" & i)をSheets(tbl(i, 1))に変えて貰たらOKですワ。 （2ヶ所ありますから気ぃ付けて!） （弥太郎） '------------------- Option Explicit Sub copy() Dim maxrow As Long, i As Long, Cnt As Long Dim tbl Application.ScreenUpdating = False With Sheets("sheet1") maxrow = .Range("a" & Excel.Rows.Count).End(xlUp).Row .Cells(1, 1).Resize(maxrow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True .Cells(1, 1).Resize(maxrow).SpecialCells(xlCellTypeVisible).copy _ Destination:=Range("iv30000") Cnt = .Cells(1, 1).Resize(maxrow).SpecialCells(xlCellTypeVisible).Count tbl = .Range("iv30000").Resize(Cnt).Value .Range("iv30000:iv65536").Clear .ShowAllData For i = 2 To Cnt Sheets("sheet" & i).Range("a:c").Clear .Range("a1").AutoFilter field:=1, Criteria1:=tbl(i, 1) .Range("a1").Resize(maxrow, 3).SpecialCells(xlCellTypeVisible).copy _ Destination:=Sheets("sheet" & i).Range("a1") Next i Application.CutCopyMode = False .Range("a1").AutoFilter End With Application.ScreenUpdating = True End Sub ---- >S50が顔出しとるし、作業が面倒という事は何十種類かのデータをコピーしたいんと >ちゃいまっか? >せやけど、何十種類もあるんやったらシート名をS1とかS2とかにしとく方が利便性に >長けてますわなぁ。 これらのことを考慮したつもりで、以下のように書き換えてみました。 あちらこちらに他所様のコードを借用しています。 フィルタオプションの設定で実行しています。 (Hatch) Sub tyu1203() Dim LastRow As Long Dim mySh As String Dim mydSh As String Dim mytSh As String Dim i As Long Application.ScreenUpdating = False mydSh = "Sheet1" '---データのあるシート名 mytSh = "Temp1" '---作業シート名 '---作業シート mySh = mytSh ShCheck (mySh) '---キーの抽出 Worksheets(mySh).Activate Worksheets(mySh).Cells.Clear LastRow = Worksheets(mydSh).Cells(65536, 1).End(xlUp).Row Sheets(mydSh).Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("A1"), Unique:=True '--- LastRow = Worksheets(mytSh).Cells(65536, 1).End(xlUp).Row For i = 2 To LastRow mySh = Worksheets(mytSh).Cells(i, 1).Value ShCheck (mySh) Worksheets(mytSh).Range("E1").Value = Sheets(mydSh).Range("A1").Value Worksheets(mytSh).Range("E2").Value = mySh Worksheets(mySh).Activate Worksheets(mySh).Cells.Clear '↓でデータ範囲を指定していますので要注意! Sheets(mydSh).Range("A1:C5501").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Worksheets("Temp1").Range("E1:E2"), CopyToRange:=Range("A1"), Unique:=False Next i Application.DisplayAlerts = False Worksheets(mytSh).Delete Application.DisplayAlerts = True '---シートの並べ替え ShSort Worksheets(mydSh).Activate Cells(1, 1).Select Application.ScreenUpdating = True End Sub Sub ShCheck(mySh As String) Dim Sheet_Name As Object For Each Sheet_Name In Worksheets If Sheet_Name.Name = mySh Then Exit Sub Next Worksheets.Add.Name = mySh End Sub Sub ShSort() Rem この部分は「http://www.relief.jp/itnote/archives/001300.php」から引用 Dim intLoopA As Integer Dim intLoopB As Integer For intLoopA = 1 To Sheets.Count For intLoopB = 1 To Sheets.Count - 1 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then Sheets(intLoopB).Move after:=Sheets(intLoopB + 1) End If Next intLoopB Next intLoopA End Sub ---- ヒュッ、ヒューッ!!! Hatchはんビューチフル（笑 あのぅ、!3本は「この世のモノとは思えんでけ映え」にランクされます〜（笑 （弥太郎） ---- おぉ〜 なんか凄く褒められたようで・・・<(｀^´)>エッヘン。 後いくつか付け加えれば、自分的には完成です。もうちょっと弄って遊んでみます。 では、機嫌良く一人遊びしときます(^.^)/‾‾‾ # あっ・・・上のコードはExcel2002で作成していますこと付け加えておきます。 (Hatch) ---- >Null様もう少し詳しく教えていただけませんかね。 よばれていたのにめさ放置してましたすいませんf^^ >Sheet1にデータを入れマクロ実行したがSheet2に何も表示されません（エラー表示もなし） これに関してはA列に[S1]が存在しない場合 シート名が違う場合(これはエラーが出るはずですが) マクロのコピー場所がSheet1のシートでない場合 に問題がでるはずですが、ちょっと詳しくは反応できませんorz あとは（弥太郎）さんのコードが私が面倒がった場所をつくってくれていますし^^ (Hatch)さんのは エラーチャックも行ってくれるようなソースを書いてくれていますので、それらを見ながらどうにかなるようなきがします。 （弥太郎）さん(Hatch)さんありがとうございます^^ いつも適当ですいません(Null) ---- Nullはん、ほないにお礼言われたらめさ恐縮しますワ（笑 （弥太郎） ---- エラーチェックはしていませんが、ちょっと手を加えたサンプルを下のHPにアップしときます。 http://www.geocities.jp/hatch4700/index.html のNo32 mitu.xls(約70KB)です。 関係ないシートは削除するようにしていますので、要注意です。 たぶんExcel2000でも完全一致になっていると思うのですが、確認はできていません。 (Hatch) (゜;)\(--;)オイオイ ---- こちらこそ(弥太郎）さんにそういわれると照れくさいですf^^ でもって俺のもUP http://yakihata.jp/excel/sumple004.xls Excel2002 Win2000で動作確認 (Hatch)さんのサンプルが動作はかなり速いですb (Null)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200512/20051201212008.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97013 documents and 608132 words.
訪問者：