Excel VBA データの入っているセルの取り出し
Excel2007使用です。
大きなセル範囲の中にデータが点在している場合に、そのデータを一か所にまとめるマクロを作りたいです。セル範囲は決まっています（A1:Q100）。最終的には隣のセルの1列にまとめたいです。
以下のようなマクロを作ってみましたが、いずれも作動しませんでした（エラーメッセージも出ず）
NullをEmptyに変えてみても同じでした。
（ややこしいですが、アクティブセルはSheet2、Sheet1へ貼り付けたい）
（とりあえずシート内で列上部にまとめようとした）
Dim myRange As Range
For Each myRange In Range("A1:Q100")
If myRange.Value = Null Then
myRange.Delete xlShiftUp
End If
Next myRange
End Sub
（1行1列ずつの参照をループさせて「空白でない」セルを切り取り-貼り付けさせようとした）
Worksheets("sheet2").Activate
Dim Gyou As Integer
Dim Retsu As Integer
For Gyou = 1 To 100
For Retsu = 1 To 17
If Cells(Gyou, Retsu).Value = Not Null Then
Cells(Gyou, Retsu).Cut Destination:=Worksheets("sheet1").Cells(5, 2)
End If
Next Retsu
Next Gyou
End Sub
また、以下のマクロは、実行すると現状のままSheet1のE列以降に移るだけで、データのあるセルだけがまとまるという状態にはなりません。
Range("A1:Q100").SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Sheet3").Range("E1")
End Sub
以下は某サイトで、まさに「空白セルを削除しデータの入ってるセルを上詰めにする」というマクロが紹介されていたので、加工してやってみましたが、「RangeクラスのDeleteメソッドが失敗しました」という実行時エラーが出てできませんでした。
Dim WS As Worksheet
Dim myRng As Range
Dim Lrow As Long
Set WS = Worksheets("Sheet1")
Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row
Set myRng = WS.Range("A1:A" & CStr(Lrow))
myRng.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub
データの入っているセルだけを取り出して一つの列にまとめたいのですが、どうしたらいいのでしょうか。
Excel VBA データの入っているセルの取り出し
Excel2007使用です。
大きなセル範囲の中にデータが点在している場合に、そのデータを一か所にまとめるマクロを作りたいです。セル範囲は決まっています（A1:Q100）。最終的には隣のセルの1列にまとめたいです。
以下のようなマクロを作ってみましたが、いずれも作動しませんでした（エラーメッセージも出ず）
NullをEmptyに変えてみても同じでした。
（ややこしいですが、アクティブセルはSheet2、Sheet1へ貼り付けたい）
（とりあえずシート内で列上部にまとめようとした）
Dim myRange As Range
For Each myRange In Range("A1:Q100")
If myRange.Value = Null Then
myRange.Delete xlShiftUp
End If
Next myRange
End Sub
（1行1列ずつの参照をループさせて「空白でない」セルを切り取り-貼り付けさせようとした）
Worksheets("sheet2").Activate
Dim Gyou As Integer
Dim Retsu As Integer
For Gyou = 1 To 100
For Retsu = 1 To 17
If Cells(Gyou, Retsu).Value = Not Null Then
Cells(Gyou, Retsu).Cut Destination:=Worksheets("sheet1").Cells(5, 2)
End If
Next Retsu
Next Gyou
End Sub
また、以下のマクロは、実行すると現状のままSheet1のE列以降に移るだけで、データのあるセルだけがまとまるという状態にはなりません。
Range("A1:Q100").SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Sheet3").Range("E1")
End Sub
以下は某サイトで、まさに「空白セルを削除しデータの入ってるセルを上詰めにする」というマクロが紹介されていたので、加工してやってみましたが、「RangeクラスのDeleteメソッドが失敗しました」という実行時エラーが出てできませんでした。
Dim WS As Worksheet
Dim myRng As Range
Dim Lrow As Long
Set WS = Worksheets("Sheet1")
Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row
Set myRng = WS.Range("A1:A" & CStr(Lrow))
myRng.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub
データの入っているセルだけを取り出して一つの列にまとめたいのですが、どうしたらいいのでしょうか。
Office XP Personal 2002
Excel 2002
今まで、メモリ等をそれほど気にしなくて使用してきましたが、
下記の １ のほうが、メモリを使わないのでよろしいかと思いますが、
どうなんでしょうか？
それとも、もっと他のことで、メモリの節約をしたほうがよろしいでしょうか。
（シートを256枚以上も使用することはありませんので）
（他の質問等をみても、Byte は、ほとんど見かけないように思いましたので）
初歩的な質問かと思われますが、
よろしくお願い致します。
'１
Dim i As Byte '1バイト
'２
Dim i As Integer '2バイト
For i = 1 To Worksheets.Count - 1
ここで質問させていただき、配列に必要なデータを入力する所までは出来ました。
次に各行ごとの"OK"の数をカウントしたいのですが、どのように記述すればよいのでしょうか？
Sub count0(a, b, c, d, e)
Dim i1 As Long
Dim i2 As Long
Dim A1 As String
Dim bb As Variant
Dim cc As Variant
Dim dd As Variant
Dim ee As Variant
Dim myLastRow As Long
Sheets(a).Select
myLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
bb = Range(b).Resize(myLastRow, 6)
cc = Range(c).Resize(myLastRow, 6)
dd = Range(d).Resize(myLastRow, 6)
ee = Range(e).Resize(myLastRow)
For i1 = 1 To myLastRow
For i2 = 1 To 6
If bb(i1, i2) = "" Then
A1 = "NG"
ElseIf bb(i1, i2) = "A1" Or cc(i1, i2) = "A1" Then
A1 = "-"
ElseIf bb(i1, i2) = cc(i1, i2) Then
A1 = "OK"
Else
A1 = "NG"
End If
dd(i1, i2) = A1
Next i2
'配列をカウントするこの行以降の記述が良く分かりません。
ee(i1) = Application.WorksheetFunction.CountIf(dd(), "OK")
Next i1
Range(e).Resize(myLastRow) = ee
End Sub
各行ごとに5回セルを参照した結果を吐き出すプログラムを作成しています。
200行前後の処理が必要なのですが、現在のコードではあまりにも処理が重くなっています。
とにかく処理を軽くしたいのですが、どのような方法が考えられるでしょうか？
初心者なのでコードも含めてご教示頂けたら幸いです。
Sub test(b, c, d)
Dim i1, i2 As Long
Dim A1 As String
For i1=0 To Cells(Rows.Count, 1).End(xlUp).Row
For i2 = 0 To 5
If Range(b).offset(i1, i2).Value = "x1" Or Range(c).offset(i1, i2).Value = "x1" Then
A1 = "XXX"
ElseIf Range(b).offset(i1, i2).Value = Range(c).offset(i1, i2).Value Then
A1 = "YYY"
Else
A1 = "ZZZ"
End If
Range(d).offset(i1, i2).Value = A1
Next i2
Next i1
End Sub
各行ごとに5回セルを参照した結果を吐き出すプログラムを作成しています。
200行前後の処理が必要なのですが、現在のコードではあまりにも処理が重くなっています。
とにかく処理を軽くしたいのですが、どのような方法が考えられるでしょうか？
初心者なのでコードも含めてご教示頂けたら幸いです。
Sub test(b, c, d)
Dim i1, i2 As Long
Dim A1 As String
For i1=0 To Cells(Rows.Count, 1).End(xlUp).Row
For i2 = 0 To 5
If Range(b).offset(i1, i2).Value = "x1" Or Range(c).offset(i1, i2).Value = "x1" Then
A1 = "XXX"
ElseIf Range(b).offset(i1, i2).Value = Range(c).offset(i1, i2).Value Then
A1 = "YYY"
Else
A1 = "ZZZ"
End If
Range(d).offset(i1, i2).Value = A1
Next i2
Next i1
End Sub
下記のマクロを作成しました。
1.Sheet1のA列の数字を１つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。
全部あればすべてのセルが赤くなり、無いところがあれば白いままというマクロ
2.sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字（検索してなかった数字）を黄色にする。
困っていることは、何も数字の無いところが全部黄色になってしまいます。
sheet1の空白のところは処理せずにそのまま白くあって欲しいのですがどのようにすればいいでしょうか？
●sheet1のA列に下記のような数字が羅列(200行程)しています。
238062
238075
238096
238210
91518
238230
123456
789123
456789
●sheet2のA列に下記のような数字が羅列しています。
91518
238062
238075
238096
238210
Sub 赤色付け()
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
Dim RowPos As Integer
Dim i As Integer
For RowPos = 1 To 200
If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then
i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0)
WS2.Cells(i, 1).Interior.ColorIndex = 3
ELSE
WS1.Cells(RowPos, 1).Interior.ColorIndex = 6
End If
Next
End Sub
