結合のループ処理のマクロ

すみません教えて下さい
以下の条件で動くマクロを作っているのですがうまくいきません

(1)sheet1、ｃ７以下にデーターが入っています最終データー行はその時によって違います
(2)sheet1,c列にデーターがあれば、必ずｆ列までデータがあります
上記条件のもと
例：sheet1 c7にデータがある場合　ｃ7～Ｆ7までのデータを　sheet2のC7に半角で結合する
上記動作をC列のセルが空白になるまで繰り返す

マクロを作成しましたがうまくいきません
sheet2のセルへ値を結合するところでエラーが出ます
どこが悪いのかご教授、ご指導をお願いします

　Sub loop1()
'
' 繰り返しMacro Macro
'

'
Dim i As Integer
i = 1
Sheets("Sheet1").Select
Range("c7").Select
Do While ActiveCell.Value <> ""
Worksheets("Sheet2").Select
Range("c7").Select
Range("c7").Value = Asc.Sheet1!C7.Value & Sheet1!D7.Value & Sheet1!E7.Value & Sheet1!F7.Value

i = i + 1
activesell.Offset(0.1).Select
Loop
End Sub

No.5 ベストアンサー 回答者： hallo-2007 回答日時： 2012/11/23 20:28

既に、すばらしい回答が出ていますが、質問者の勉強という事で捕捉します。

Sheet1!C7.Value & Sheet1!D7.Value & Sheet1!E7.Value & Sheet1!F7.Value
関数の記述の仕方です。VBAのコードではありませんよ。

activesell.Offset(0.1).Select
スペルミス、点とカンマ、行と列の指定の間違い

Activeなセルを一行ずつ下へずらすには
ActiveCell.Offset(1, 0).Activate
と記述します。

Do　while を使ったLoopですが、出来るだけ今のコードを生かすとして

Sub loop1()
Dim i As Integer
i = 7
Sheets("Sheet1").Range("c7").Select
Do While ActiveCell.Value <> ""
Worksheets("Sheet2").Range("c" & i).Value = Range("c" & i).Value
i = i + 1
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

となります、セルの結合と半角への変換は無視しています。
まずは、これだけで、何を行っているかいるか理解してみてください。

この回答へのお礼

親切なご指導ありがとうございます。

お礼日時：2012/11/25 00:08

No.4 回答者： WindFaller 回答日時： 2012/11/23 13:57

こんにちは。

ご質問のコードを見る限りは、まだ掲示板で質問する段階にはないように思います。
まず、VBEditor に書いてみて、赤い字が出た所を修正するようにしなければなりませんね。また、デバッグ--コンパイルをしたら、エラーが出ていないとか確認してください。

できるだけ、基本的な所を積み上げたほうがよいです。今の段階では、回答を貰っても、解説のないコードだけでは、全部は把握できないかもしれません。


'//
Sub CombineData()
　Dim ws2 As Worksheet
　Dim LastRow As Long　'最後の行
　Dim i As Long
　Dim v As Variant
　Set ws2 = Worksheets("Sheet2")
　With Worksheets("Sheet1")
　　LastRow = .Cells(Rows.Count, "C").End(xlUp).Row
　　For i = 7 To LastRow　'7行目から
　　　If .Cells(i, "C").Value <> "" Then
　　　　v = .Cells(i, "C").Value _
　　　　　　　& .Cells(i, "D").Value _
　　　　　　　& .Cells(i, "E").Value _
　　　　　　　& .Cells(i, "F").Value
　　　　ws2.Cells(i, "C").Value = StrConv(v, vbNarrow) '半角
　　　End If
　　Next i
　End With
　Set ws2 = Nothing
End Sub

この回答へのお礼

ありがとうございます

お礼日時：2012/11/25 00:09

No.3 回答者： JazzCorp 回答日時： 2012/11/23 13:46

最後で間違った、、、ENDの直前、、、

（正）
zSheet.Columns("C").AutoFit
（誤）
省略

この回答へのお礼

ありがとうございます

お礼日時：2012/11/25 00:09

No.2 回答者： JazzCorp 回答日時： 2012/11/23 13:08

Ｃ列途中に空白がある場合、その行はスキップしている。

Sheet1とSheet2の行位置は対応させているので、Sheet2の方を詰める場合は、nn = i、をコメントにする
最初にＣ列をクリアしている。問題があれば、zSheet.Columns("C").Clear、をコメントにする

Option Explicit
'Sub loop1()
Sub TheNextNew()
Const xNum = 7
Dim i As Long
Dim nn As Long
Dim xLast As Long
Dim xSheet As Worksheet
Dim zSheet As Worksheet
'i = 1
'Sheets("Sheet1").Select
Set xSheet = ThisWorkbook.Sheets("Sheet1")
Set zSheet = ThisWorkbook.Sheets("Sheet2")
zSheet.Columns("C").Clear
xLast = xSheet.Cells(Rows.Count, "C").End(xlUp).Row
'xSheet.Range(Cells(7, "C"), Cells(xLast, "C")).Select
'Do While ActiveCell.Value <> ""
nn = xNum
For i = xNum To xLast
'Worksheets("Sheet2").Select
'Range("c7").Select
'Range("c7").Value = Asc.Sheet1!C7.Value & Sheet1!D7.Value & Sheet1!E7.Value & Sheet1!F7.Value
If (xSheet.Cells(i, "C").Value <> Empty) Then
nn = i
zSheet.Cells(nn, "C").Value = StrConv(xSheet.Range("C" & i).Value & xSheet.Range("D" & i).Value & xSheet.Range("E" & i).Value & xSheet.Range("F" & i).Value, vbNarrow)
nn = nn + 1
End If
'i = i + 1
'ActiveCell.Offset(0.1).Select
'Loop
Next
zSheet.Select
zSheet.Rows(xNum).AutoFit
End Sub

この回答へのお礼

ありがとうございます。
大変勉強になりました。

お礼日時：2012/11/25 00:07

No.1 回答者： keithin 回答日時： 2012/11/23 11:40

＞どこが悪い

シート名、セル番地のマクロの書き方が全然デタラメです。

作成例：
sub macro1()
　dim r as long
　dim c as long
　for r = 7 to worksheets("Sheet1").range("C6556").end(xlup).row
　　worksheets("Sheet2").cells(r, "C").clearcontents
　　if worksheets("Sheet1").cells(r, "C") <> "" then
　　　for c = 3 to 6
　　　　worksheets("Sheet2").cells(r, "C") = worksheets("Sheet2").cells(r, "C") & worksheets("Sheet1").cells(r, c)
　　　next c
　　end if
　next r
end sub

この回答へのお礼

詳しい解答ありがとうございます

お礼日時：2012/11/25 00:10