|
▼Statis さん:
>こんにちは
>一度試してみてください。
>
>Sub Test2()
>Dim MyFil As String, Wb As Workbook, Ws As Worksheet
>Dim NowWb As Workbook, NowWs As Worksheet, C As Range, R As Range
>
>MyFil = Application.GetOpenFilename("テキスト ファイル (*.csv), *.csv")
>If MyFil = "False" Then Exit Sub
>Application.ScreenUpdating = False
>Set Ws = ThisWorkbook.Worksheets("Sheet1")
>Set NowWb = Workbooks.Add(1)
>Set Wb = Workbooks.Open(MyFil)
>With Wb.ActiveSheet
> Set R = .Range("D1", .Range("D65536").End(xlUp)).Offset(, 4)
> R.AdvancedFilter xlFilterCopy, , Ws.Range("A1"), True
> If .AutoFilterMode = False Then
> .Rows(1).AutoFilter
> End If
> For Each C In Ws.Range("A2", Ws.Range("A65536").End(xlUp)).SpecialCells(xlCellTypeConstants)
> If Not IsEmpty(C.Value) Then
> R.AutoFilter 8, C.Value
> If .Range("H65536").End(xlUp).Row > 1 Then
> Set NowWs = NowWb.Worksheets.Add
> NowWs.Name = C.Value
> .AutoFilter.Range.Copy NowWs.Range("A1")
> With NowWs
> .Rows(1).Delete
> .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1") _
> , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False _
> , Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal _
> , DataOption2:=xlSortTextAsNumbers
> .Columns("A:B").Delete
> .Cells.EntireColumn.AutoFit
> End With
> Set NowWs = Nothing
> End If
> End If
> Next C
> .AutoFilterMode = False
>End With
>Ws.Columns(1).Clear
>Wb.Close False
>With Application
> .DisplayAlerts = False
> NowWb.Sheets("Sheet1").Delete
> .DisplayAlerts = True
> .ScreenUpdating = True
>End With
>Set NowWb = Nothing: Set Ws = Nothing: Set Wb = Nothing
>Set R = Nothing
>End Sub
>
>
>確認事項
>1、オートフィルタは1行目の設定になっているか?
>2、データは抽出されているか?
>3、コピーされているか?
>
>明日、再度見ます。
.UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal _
, DataOption2:=xlSortTextAsNumbers
状況をご報告します
上記にてRangeクラスsortメソッド失敗となり
下記状況です
元データ 1行目にフィルタ有
Book1 A:1にカーソル有
1行目に目次 2行目空 3行目より抽出された値
(H列に空もあるので上記2行目が それを抽出してくれているとしたら
こちらの勘違いで申し訳ないです)
sheet1の脇に 抽出されたH列値有
途中下記にブレークポイント作成
状況同じでsheet1とsheet2が作成されている
NowWs.Name = C.Value
毎回申し訳御座いません。
|
|