No.1
- 回答日時:
作業が良く呑み込み出来ません。
第1回A1:A10--->別シート(?)A1:J1
B1:B10---> K1:T1
第2回A11:A20(?)--->???
B11:B20(?)--->???
第3回????
3000件とはSheet1(例)に約3000行のデータがあるてことですか。
表にデータがあるのは、A1:B3000ですか。
この回答への補足
早朝レスありがとうございますm(_ _)m。
一つのシートに3000行です、データがあるのはA1:B3000ですが現在はこれを
1.行の挿入で数行空ける(仮に5行挿入すればデータはA6:B3006にずれます)
2.A6:A15をコピーし、形式を選択して貼り付けでA1:J1へ行列を入れ替えて貼り付け
3.B6:B15をコピーし、形式を選択して貼り付けでK1:T1へ行列を入れ替えて貼り付け
4.貼り付けが済んだA6:B15を削除
5.上記1~4で1つのセット、次はA16:A25をコピーしてA2:J2へ、B16:B25をコピーしてK2:T2へ、コピーが済んだA16:B25は削除・・・と繰り返していく
6.だんだんとコピー元と貼り付け場所が離れていくので時々行削除して作業しやすいようにしなければいけない。見た目としては2列の細長いデータが20列の長方形に変わっていく。
上記のように処理しています
No.2
- 回答日時:
多分こういうのはマクロを使わないと無理だと思います。
念のため「形式を選択して貼り付け」は「値」だけを選ぶんですよね?
ツール(T)→マクロ(M)→Visual Basic Editor(V)
または
Alt+F11
で
Visual Basic Editorを起動する。
挿入(I)→標準モジュール(M)
として
右側に出来たウィンドウに
Sub irekae()
Const halfretsu = 10
Dim mototop As Integer
Dim atotop As Integer
mototop = 1
atotop = 1
Do While Cells(mototop, 1).Value <> ""
Call ido(mototop, atotop, halfretsu)
mototop = mototop + halfretsu
atotop = atotop + 1
Loop
End Sub
Private Sub ido(mototop, atotop, halfretsu)
Dim tempnum As Integer
Dim tempchar As String
Dim i As Integer
For i = 1 To halfretsu
tempnum = Cells(mototop + i - 1, 1).Value
Cells(mototop + i - 1, 1).Value = ""
tempchar = Cells(mototop + i - 1, 2).Value
Cells(mototop + i - 1, 2).Value = ""
Cells(atotop, i).Value = tempnum
Cells(atotop, i + halfretsu).Value = tempchar
Next
End Sub
をコピーして貼り付けてください。
その後上書き保存をしてVisual Basic Editorを閉じてください。
ツール(T)→マクロ(M)→マクロ(M)
または
Alt+F8
で呼び出したウィンドウの
irekae
を選んで
実行(R)
をクリックしてください。
回答に対する補足にあるアルゴリズムだと無駄があるので一部を省いて結果として同じになるものになってるはずです。
この回答への補足
すみません!使えました!
私が2回貼り付けボタンを押していたようですm(__;)m
Visual Basic Editorの使用方法もあり大変わかりやすいです。
そこでちょっと相談なのですが、元データの途中に空行がある場合、並べ替え後データも空行を作ることはできるでしょうか?
1 1234
2
3 567
4
→
5
6
7
という感じで1行10個なくても改行になり、さらに1行空行を入れてまた続きが入る。
なんとかなりますでしょうか・・・
No.3
- 回答日時:
テストデータとして
A1に1、A2に2を入れ、A1:A2を範囲指定して
+ハンドルを出し引っ張る。1-数百の連続数を入力する。
B1に501、B2に502を入れ、B1:B2を範囲指定して+ハンドルを出し下へ引っ張る。501-連続数を
セルにセットする。
Sub test02()
j = 1
'For i = 1 To 3000 Step 10
For i = 1 To 300 Step 10
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range(Cells(i, "A"), Cells(i + 9, "A")).Copy
Worksheets("Sheet2").Select
Cells(j, "A").Select
Selection.PasteSpecial Paste:=xlAll, Transpose:=True
'-------
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range(Cells(i, "B"), Cells(i + 9, "B")).Copy
Worksheets("Sheet2").Select
Cells(j, "K").Select
Selection.PasteSpecial Paste:=xlAll, Transpose:=True
j = j + 1
Next i
End Sub
を標準モジュール画面にコピーし、実行する。
結果はSheet2にA1:TXXXに
1、2、3・・10,501,502、・・510
11,12、13・・511、512,513、・・520
21,22,23、・・521,522、・・530
・・・
となります。
「標準モジュール画面にコピーし、実行する」方法がわからなければ補足します。
’の付いた行は3000行を処理するときのためです。
’を省けば3000行用になります。その時は
For i = 1 To 300 Step 10の行を抹消します。
回答ありがとうございます。
実はデータは3000件ちょうどではなく、その時々で異なります。
なのでこのVBAだと都度件数を把握しなければならず少々不便な感じがしました。(勝手いってすみません)
No.4
- 回答日時:
お望みの処理はこんな感じでしょうか?
汎用的な可変タイプのマクロを組んでみました。
バックアップを作成してから下記のマクロを試してみて下さい。
--------------------------------------------------
Sub Macro()
Dim myLastLow As Long, i As Long, n As Long
Dim str As String, str2 As String
Dim str_rv As String, str_rv2 As String, str_rv3 As String, str_rv6 As String
n = 1
n2 = 1
myLastLow = Range("A65536").End(xlUp).Row
Cells(1, 1).Select
MsgBox "myLastLow = " & myLastLow
For i = 1 To myLastLow Step 10
str_rv = i
str_rv2 = i + 9
str_rv3 = n
str_rv6 = n + 1
str = "A" + str_rv + ":A" + str_rv2
Range(str).Select
Application.CutCopyMode = False
Selection.Copy
Range("C" + str_rv3).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
str2 = "B" + str_rv + ":B" + str_rv2
Range(str2).Select
Application.CutCopyMode = False
Selection.Copy
Range("C" + str_rv6).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
n = n + 2
Next i
MsgBox "A&B列を削除します。"
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
No.5
- 回答日時:
No,#4です。
勘違いしておりました。スミマセンm(__)m
再調整版をUPします。
--------------------------------------------------
Sub Macro2()
Dim myLastLow As Long, i As Long, n As Long
Dim str As String, str2 As String
Dim str_rv As String, str_rv2 As String, str_rv3 As String, str_rv6 As String
n = 1
n2 = 1
myLastLow = Range("A65536").End(xlUp).Row
Cells(1, 1).Select
MsgBox "myLastLow = " & myLastLow
For i = 1 To myLastLow Step 10
str_rv = i
str_rv2 = i + 9
str_rv3 = n
str_rv6 = n
str = "A" + str_rv + ":A" + str_rv2
Range(str).Select
Application.CutCopyMode = False
Selection.Copy
Range("C" + str_rv3).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
str2 = "B" + str_rv + ":B" + str_rv2
Range(str2).Select
Application.CutCopyMode = False
Selection.Copy
Range("M" + str_rv6).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
n = n + 1
Next i
MsgBox "A&B列を削除します。"
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
この回答への補足
※お礼文の100文字制限でお礼が切れてしまいました、すみません。
回答ありがとうございます!うまく動いたのですが↓のような事はできるものでしょうか?
そこでちょっと相談なのですが、下の方にも着込みしたのですが、元データの途中に空行がある場合、並べ替え後データも空行を作ることはできるでしょうか?
1 1234
2
3 567
4
→
5
6
7
という感じで1行10個なくても改行になり、さらに1行空行を入れてまた続きが入る。
なんとかなりますでしょうか・・・
No.6
- 回答日時:
#1,#3のものです。
実はデータは3000件ちょうどではなく、その時々で異なります。
なのでこのVBAだと都度件数を把握しなければならず
少し色々盛りこまないように遠慮してました。
簡単です。
d = Range("a1").CurrentRegion.Rows.Count
かまたは
d=Range("A65536").End(xlUp).Row を最初に入れる。
For i = 1 To 300 Step 10 をFor i = 1 To d Step 10
に変更するで解決します。
この回答への補足
元データの途中に空行がある場合、並べ替え後データも空行を作ることはできるでしょうか?
1 1234
2
3 567
4
→
5
6
7
という感じで1行10個なくても改行になり、さらに1行空行を入れてまた続きが入る。
なんとかなりますでしょうか・・・
imogasiさんは朝早いんですね(^^)丁寧にありがとうございます。
試したところ無事うごきました、ありがとうございます。
そこで相談なのですが↑補足のような事もできるものでしょうか?
No.7
- 回答日時:
#6のものです。
#6の補足にお書きになっている要求は、やって見たところ#3の回答のままで叶えられると思います。
A列、B列に空白のセルが散在・混在しておれば、そのまま所定の所へ空白セルを移します。
やってみてくださって、不都合な点があればお知らせ下さい。
この回答への補足
私の説明不足ですみません、補足致します。
所定のセル(行)が空白である場合そのまま移すのではなく空行を一つ作って欲しいのです。2行以上の空白(行)があればマクロを止めて欲しいのです。A列1~31、B列あ~、の場合で3行目と10行目に空行がある場合
12 あい
※3行目がないので空行
456789 うえおかきく
※10行目がないので空行
11121314151617181920けこさしすせそたちつ
21222324252627282930てとなにぬねのはひふ
31 へ
このような説明でわかりますでしょうか・・・
No.8
- 回答日時:
No,#4-5です。
補足要求しますが、元軸計算はA列(数字)の方でよろしいのでしょうか?
例えばB列(文字)に空行(NULL)がある場合の扱いは同じくご質問にあるように空行扱いでOKなのか、
又は、あくまでA列が空行だった場合だけに空行処理をするのか、その辺が曖昧な感じがします。
*:A列が空行なら必ずB列も空行なのでしょうか?
*:移し替えが10未満でも途中に空行があったら強制的に行をあけるのでしょうか?
この回答への補足
A列が空行なら必ずB列も空行です。
移し替えが10未満でも途中空行があったら強制的に行を空けます。
1~50のデータで25行目と31行目が空行であれば
1 2 3 4 5 6 7 8 910
11121314151617181920
21222324
2627282930
32333435363738394041
424344454647484950
と並んで欲しいのです
No.9
- 回答日時:
No.2です。
前のは10行ずつ書入りした後の次のA列のトップ(例えばA41)に空欄があったらストップするように作ってあったのでたまたまそこに空欄があったら止まってしまうものでした。
とりあえず、元のデータが行数が1万行未満という想定で作り変えてみました。
Option Explicit
Sub irekae()
Const halfretsu = 10
Dim mototop As Integer
Dim atotop As Integer
Dim gyou As Integer
Dim gyouA As Integer
Dim gyouB As Integer
mototop = 1
atotop = 1
gyouA = Range("A10000").End(xlUp).Row
gyouB = Range("B10000").End(xlUp).Row
If gyouA >= gyouB Then
gyou = gyouA
Else
gyou = gyouB
End If
Do While mototop <= gyou
Call ido(mototop, atotop, halfretsu)
mototop = mototop + halfretsu
atotop = atotop + 2
Loop
End Sub
Private Sub ido(mototop, atotop, halfretsu)
Dim tempnum As Integer
Dim tempchar As String
Dim i As Integer
For i = 1 To halfretsu
If Cells(mototop + i - 1, 1).Value <> "" Then
tempnum = Cells(mototop + i - 1, 1).Value
Cells(mototop + i - 1, 1).Value = ""
Cells(atotop, i).Value = tempnum
End If
tempchar = Cells(mototop + i - 1, 2).Value
Cells(mototop + i - 1, 2).Value = ""
Cells(atotop, i + halfretsu).Value = tempchar
Next
End Sub
No.10
- 回答日時:
すいませんなんか勘違いしていたようで
もし途中で空行があったらその行へのコピーをやめて一行あけてからコピーを再開する。
でいいんですね?
Option Explicit
Sub irekae()
Const halfretsu = 10
Dim mototop As Integer
Dim atotop As Integer
Dim gyou As Integer
Dim thislinec As Integer
mototop = 1
atotop = 1
gyou = Range("A10000").End(xlUp).Row
Do While mototop <= gyou
thislinec = ido(mototop, atotop, halfretsu)
mototop = mototop + thislinec
If thislinec >= halfretsu Then
atotop = atotop + 1
Else
atotop = atotop + 2
End If
Loop
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
End Sub
Private Function ido(mototop, atotop, halfretsu)
Dim tempnum As Integer
Dim tempchar As String
Const yobiake = 3
Dim i As Integer
For i = 1 To halfretsu
If Cells(mototop + i - 1, 2).Value = "" Then
Exit For
End If
tempnum = Cells(mototop + i - 1, 1).Value
Cells(mototop + i - 1, 1).Value = ""
Cells(atotop, i + yobiake).Value = tempnum
tempchar = Cells(mototop + i - 1, 2).Value
Cells(mototop + i - 1, 2).Value = ""
Cells(atotop, i + halfretsu + yobiake).Value = tempchar
Next
ido = i
End Function
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelに文字データのみを貼り付けたい 8 2023/05/03 15:38
- Excel(エクセル) [オートフィルター]機能について 3 2023/02/04 14:32
- Excel(エクセル) Googleスプレッドシートで、あるセルの値に応じて行を自動挿入したい 急いでいます! くわしい方、 3 2023/03/06 19:05
- Excel(エクセル) Excel 値を返す数式についてです 3 2022/11/21 20:08
- Excel(エクセル) Excelにの以下の設定方法について教えてください! C列にデータ入力の設定をしています。(出、入を 3 2022/06/22 01:33
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Excel(エクセル) エクセルシートのデータを1列飛ばしで別ブックのシートに貼り付けるマクロが知りたい 2 2023/06/05 22:37
- Visual Basic(VBA) Excel vbaについて知恵もしくは、コード教えて下さいm(__)m ① 表にあるデータをコピー、 2 2022/09/01 23:57
- Excel(エクセル) VLOOKUP が機能しない、その原因は何 ? 8 2022/10/19 12:06
- Visual Basic(VBA) 指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける 3 2022/09/10 07:55
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで二つの数字の小さい...
-
PowerPointで表の1つの列だけ...
-
VBAで文字列を数値に変換したい
-
エクセル 同じ値を探して隣の...
-
エクセルで最初のスペースまで...
-
エクセル初心者です 関数の入れ...
-
2つのエクセルのデータを同じよ...
-
Excelで半角の文字を含むセルを...
-
LOOKUP関数を使えばいいのでし...
-
エクセル 文字数 多い順 並...
-
Excel、市から登録している住所...
-
A列がない・・・A列が非表示に...
-
エクセルの表から正の数、負の...
-
エクセルで文字が混じった数字...
-
エクセル(勝手に太字になる)
-
エクセルの項目軸を左寄せにしたい
-
重複行を削除して数値を合算し...
-
エクセルの並び変えで、空白セ...
-
EXCELで 一桁の数値を二桁に
-
基準日よりも古い日付の列を削...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで二つの数字の小さい...
-
PowerPointで表の1つの列だけ...
-
エクセルで最初のスペースまで...
-
2つのエクセルのデータを同じよ...
-
エクセル(勝手に太字になる)
-
「B列が日曜の場合」C列に/...
-
エクセル 文字数 多い順 並...
-
EXCELで 一桁の数値を二桁に
-
エクセル 同じ値を探して隣の...
-
VBAで文字列を数値に変換したい
-
エクセルの並び変えで、空白セ...
-
Excelで半角の文字を含むセルを...
-
エクセルで文字が混じった数字...
-
Excel、市から登録している住所...
-
A列がない・・・A列が非表示に...
-
エクセルの表から正の数、負の...
-
[関数得意な方]教えて下さい・...
-
エクセルの項目軸を左寄せにしたい
-
エクセル 時間帯の重複の有無
-
Excelにてある膨大なデータを管...
おすすめ情報