エクセルでこんなこと可能でしょうか?

質問

部材関係部門に勤務するものですが、日々の膨大な納品データーの内から限られたものを抜出し、注文先へ送る仕事をしていますが、元となるデーターファイルが下記のようなレイアウトで並んでいます。
　私の供給先は派遣社員ばかりで、知識が乏しく、間違った使用方法が相次いでいるので、元データーを加工して表示用ラベルを作りたいのですが、A4用紙を横使いにして１シートを3列×4枚の１２枚にしたいと考えています。

　自分でINDEXやINDIRECT等の関数式を色々やりましたが、式を作り下段にフィルドラッグすると、セル番地がずれて、思うようにレイアウトすることができません。横書きのデーターを縦書きに表示を変え、データー増加に対応できるようにしたいのですが、中々、難しくて考えているような代物ができません。行列を入れ替えて貼り付けしても可能なのですが、時間が係り、作業が進みません。

　エクセルに詳しく、精通されている方でよい方法をご存知の方が居られましたら、アドバイスよろしくお願いします。

日 順 名前 番号 量
1 8/30 1 Ｄ３５ 215 170
2 8/30 2 Ｂ２５ 215 55　A～E列
3 8/30 3 Ｘ４０ 215 100
4 8/30 4 Ｘ６３ 215 30　　　　　

日 順 名前 番号 量
1 8/30 4 Ｘ６３ 383 30
2 8/30 2 Ｂ２５ 384 55　F～J列
3 8/30 3 Ｘ４０ 384 100
4 8/30 4 Ｘ６３ 384 30

日 順 名前 番号 量
1 8/30 3 Ｘ４０ 362 100
2 8/30 4 Ｘ６３ 362 30　K～O列
3 8/30 2 Ｂ２５ 383 55
4 8/30 3 Ｘ４０ 383 100
　　　　　　　　　↓

日 8/30　　 日 8/30　　 日 8/30
順 1　　　　　順 4　　　　　順 3
名前 Ｄ３５　名前　Ｘ６３　名前　　Ｘ４０
番号 215　　番号 383　　番号 362
量 170　　　　量 30　　　　量 100

というような構成に表示を変えたいのですが、関数でできるのでしょうか？

回答No.3

s_yoshi_6 · ベストアンサー

次のようにされてはいかがでしょうか。

前提条件
・Sheet1に元の表。１行目が見出し、２行目以降にデータが入力されている。
・Sheet2に印刷用の表。Ａ・Ｃ・Ｅ列が見出し、Ｂ・Ｄ・Ｆ列がデータ。１行目から５行ごとを１区切りとする。

手順
1）Sheet2で
A1：=INDIRECT(ADDRESS(1,MOD(ROW()+4,5)+1,,,"Sheet1"))
B1：=INDIRECT(ADDRESS(INT((ROW()+9)/5),MOD(ROW()+4,5)+1,,,"Sheet1"))
とし、B1のセル書式を日付にする。

2）A1:B1をC1:F1までコピーし、数式を一部書き換えて次のようにする。
C1：=INDIRECT(ADDRESS(1,MOD(ROW()+4,5)+6,,,"Sheet1"))
D1：=INDIRECT(ADDRESS(INT((ROW()+9)/5),MOD(ROW()+4,5)+6,,,"Sheet1"))
E1：=INDIRECT(ADDRESS(1,MOD(ROW()+4,5)+11,,,"Sheet1"))
F1：=INDIRECT(ADDRESS(INT((ROW()+9)/5),MOD(ROW()+4,5)+11,,,"Sheet1"))
（C1とD1は「+1」を「+6」、E1とF1は「+1」を「+11」と書き換え）

3）１列目をコピー、２～５列を範囲選択して、編集→形式を選択して貼り付けで「数式」にチェックを入れて貼り付け。

4）２～５列を範囲選択してコピー、６～２０列を範囲選択して貼り付け。（ 3）と 4）で手順を分けたのは、日付のセルが日付書式のため、そのままのコピー貼り付けでは全て日付書式になってしまうためです）

以上で3列×4枚の形になると思います。
あとは印刷プレビューで余白を適当に大きくして、１ページあたりの行数が５行になるように調整されると良いと思います。

なお、1）2）で使ったROW関数は、数式が入力されているセルの行番号を返す関数ですので、例えば、印刷用の表を６列目からにするなら
A2：=INDIRECT(ADDRESS(1,MOD(ROW()-1,5)+1,,,"Sheet1"))
B2：=INDIRECT(ADDRESS(INT((ROW()+4)/5),MOD(ROW()-1,5)+1,,,"Sheet1"))

として、ROW関数を使った部分が
Ax：=INDIRECT(ADDRESS(1,MOD(「５」,5)+1,,,"Sheet1"))
Bx：=INDIRECT(ADDRESS(INT(「１０」/5),MOD(「５」,5)+1,,,"Sheet1"))
のように、常に「５」と「１０」になるように調整して下さい。

お礼

ご返答有難うございます。それほど関数に詳しい方ではありませんがs yosi6さんからいただいたアドバイスを参考にして作り変えてみます。

　詳細な数式を連絡していただいて本当に有難うございました。

回答No.5

tona-tona

数式初心者・VBA初級者です。
A1～O1に項目、A2～O5にデータという前提で作ってみました。

Sub データシートをアクティブにして実行してね()

Dim Sh0 As Worksheet
Dim Sh1 As Worksheet
Dim ShName As String
Dim ShName0 As String
Dim I As Long
Dim M As Long
Dim R1 As Long
Dim Rsp As Integer

Dim Arr0 As Variant
Dim Arr1(1 To 20, 1 To 2) As Variant

Application.ScreenUpdating = False

Set Sh0 = ActiveSheet
Set Sh1 = ActiveWorkbook.Sheets.Add(after:=Worksheets(Sheets.Count))

On Error GoTo FAIL
I = 1
ShName0 = Format(Date, "mmdd")
ShName = ShName0
Sh1.Name = ShName
On Error GoTo 0

For M = 1 To 3

Arr0 = Sh0.Cells(1, 1 + 5 * (M - 1)).Resize(5, 5).Value

For R1 = 1 To 20

Arr1(R1, 1) = Arr0(1, ((R1 - 1) Mod 5) + 1)
Arr1(R1, 2) = Arr0(Int((R1 + 9) / 5), ((R1 - 1) Mod 5) + 1)
Next R1

Sh1.Cells(1, 1 + 2 * (M - 1)).Resize(20, 2).Value = Arr1
Erase Arr0
Erase Arr1

Next M

Range("B1,B6,B11,B16,D16,D11,D6,D1,F1,F6,F11,F16").NumberFormatLocal = "m/d"
Range("B3,B8,B13,B18,D3,D8,D13,D18,F3,F8,F13,F18").HorizontalAlignment = xlRight

Application.ScreenUpdating = True

Rsp = MsgBox("転記は終わりました。" & Chr(13) & "このまま編集を続けていいですか？", vbOKCancel)
If Rsp = vbCancel Then End

Application.ScreenUpdating = False

Columns(1).Resize(, 2).Insert Shift:=xlToRight
Columns(5).Resize(, 4).Insert Shift:=xlToRight
Columns(11).Resize(, 4).Insert Shift:=xlToRight

Rows(1).Insert Shift:=xlDown
Rows(7).Resize(2).Insert Shift:=xlDown
Rows(14).Resize(2).Insert Shift:=xlDown
Rows(21).Resize(2).Insert Shift:=xlDown

Rows.RowHeight = 17.25

Union(Columns(1), Columns(6)).ColumnWidth = 5
Union(Columns(2), Columns(5)).ColumnWidth = 3

With Range("A1:F7")
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With Range("B3:E6")
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

Range("A1:F7").AutoFill Destination:=Range("A1:F28"), Type:=xlFillFormats
Columns(1).Resize(, 6).Copy
Columns(7).Resize(, 12).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.DisplayGridlines = False

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.LeftMargin = Application.CentimetersToPoints(2)
.RightMargin = Application.CentimetersToPoints(2)
.TopMargin = Application.CentimetersToPoints(2.5)
.BottomMargin = Application.CentimetersToPoints(2.5)
.HeaderMargin = Application.CentimetersToPoints(1.3)
.FooterMargin = Application.CentimetersToPoints(1.3)
End With

Sh1.Cells(1).Activate

Application.ScreenUpdating = True

Exit Sub

FAIL:
I = I + 1
ShName = ShName0 & "(" & I & ")"
Resume

End Sub

動作チェックはしてありますが、試す時はバックアップとってからにして下さいね。
（動作check：Excel97)

お礼

ご返答有難うございました。
VBAプログラムを実行させていただきましたが、シールがいとも簡単に出来上がり、大助かりです。

　手間暇かけて作成していただき、本当に有難うございました。

回答No.4

excel-jiten

VBA作ってみました。
いかがでしょうか？

Sub macro_transpose()

Set orgSheet = Worksheets("Sheet1")
Set targetSheet = Worksheets("Sheet2")

targetColumn = 2

For orgColumn = 0 To 2 * 5 Step 5
For orgRow = 2 To 5
targetRow = 1
For columnOffset = 1 To 5
targetSheet.Cells(targetRow, targetColumn).Value _
= orgSheet.Cells(orgRow, orgColumn + columnOffset).Value
targetSheet.Cells(targetRow, targetColumn - 1).Value _
= orgSheet.Cells(1, columnOffset).Value
targetRow = targetRow + 1
Next columnOffset
targetColumn = targetColumn + 2
Next orgRow
Next orgColumn
End Sub

お礼

私ごときの様な者のために、詳細なVBAプログラムを作成していただき有難うございます。

　私のレベルはまだまだ低くて、excel-jitenさんのように思い通りにプログラムを組めませんが,VBAにもチャレンジしてみます。
　有難うございました。

回答No.2

_akane

とりあえず行と列を入れ替える*だけ*なら
=TRANSPOSE(範囲)
という関数があります。

例えばA1からD1のデータをA11からA14に転記するなら
　式を設定する範囲(A11～A14)を選択し
　数式バーに以下のように入力
　　=TRANSPOSE($A$1:$D$1)
　Ctrl+Shift+Enterキーを押して配列関数にしてからコピー

補足

ご返答有難うございます。
この関数も試しはしたのですが、下にコピーしたらセル番地がずれてしまい、上手く表示できませんでした。使い方を誤っているのかも知れません。

回答No.1

fly_moon

こんにちは。
ラベルを作りたいだけなら、ExcelのデータをWordの差し込み印刷でされるのでは不十分でしょうか？
関数で出来ないこともないかもしれませんが、やる意味が無いように思います。

どうしてもExcelのみでやりたいなら、関数ではなく、VBAでやるということになると思います。

まず、Wordの差し込み印刷をヘルプで調べてみてください。

あと、Excelの関数の参照ですが、絶対参照を使えば、コピぺしても参照範囲がずれませんよ。絶対参照もヘルプで調べてみてください。