|    | 
     ▼β さん: 
こんなに早くお返事を頂けるとは思っていませんでした。 
おかげ様で、きれいにデータを並び替えることができました。正直、配列準備のところはぱっと見ただけではよく分かりませんが、じっくり調べて理解したいと思います。何度も貴重なお時間を割いて頂き、本当にありがとうございました!!m(_ _)m 
>▼ayu さん: 
> 
>以下、試してください。 
> 
>Sub Sample3() 
>  Dim shF As Worksheet 
>  Dim shT As Worksheet 
>  Dim v As Variant 
>  Dim w As Variant 
>  Dim x As Long 
>  Dim y As Long 
>  Dim i As Long 
>  Dim j As Long 
>   
>  Application.ScreenUpdating = False '処理中の画面の動きを隠す 
>  Set shT = ThisWorkbook.Sheets("フォーマット")                          '★ 
>  Set shF = Workbooks.Open(ThisWorkbook.Path & "\元のブック.xlsx").Sheets("該当のシート名")    '★ 
>   
>  With shF.Range("A1").CurrentRegion '元シートの表領域 
>    '転記用配列準備(厳密には、こんなに大きくなくてもいいですが) 
>    ReDim v(1 To .Rows.Count, 1 To .Columns.Count * 2) 
>    For i = 2 To .Rows.Count Step 2 
>      If WorksheetFunction.CountIf(.Rows(i), ">0") > 0 Then 'すべて 0 なら対象外 
>        y = y + 1  '転記行 
>        x = 0    '転記列 
>        For j = 1 To .Columns.Count 
>          If .Cells(i, j) > 0 Then 
>            x = x + 1 
>            v(y, x) = .Cells(i - 1, j).Value 
>            v(y, x + 1) = .Cells(i, j).Value 
>            x = x + 1 
>          End If 
>        Next 
>      End If 
>    Next 
>  End With 
>   
>  shF.Parent.Close False '元ブックを閉じる 
>  '結果を一括転記 
>  shT.Cells.ClearContents 
>  shT.Range("A1").Resize(y, UBound(v, 2)) = v 
> 
>End Sub 
 | 
     
    
   |