[حل شده] انتخاب یکی از ستون ها در حلقه For و سپس ستون بعدی

[morteza71]

با سلام و خدا قوت
من میخواهم داده های یک ستون را با حذف رکورد های خالی به ستون دیگر منتقل و سپس ستون بعدی و بعدی همین عمل را انتجام دهد . تا 20 ستون
مشکل من انتخاب ستون دوم بعد از انجام عملیات روی ستون اول بوده و همینطور سوم و ...
چطور باید اینو تو حلقه نشون بدم . متشکرم

[iranweld]

با سلام


فایل پیوست را بررسی کنید

Sub TEST()

K1 = Application.WorksheetFunction.CountA(Sheet1.Range("1:1"))

K2 = 1

Dim LIST1 As New Collection

For J = 1 To K1

Z1 = Cells(Rows.Count, J).End(xlUp).Row

For I = 2 To Z1

If Cells(I, J) <> "" Then

LIST1.Add Cells(I, J)

End If

Next I

Next J

For I = 1 To LIST1.Count

Cells(K2, K1 + 2) = LIST1.Item(I)

K2 = K2 + 1

Next

End Sub 

[morteza71]

با سلام
متشکرم از وقتی که از این بابت گذاشتید . مورد نظر من حذف سلول های خالی در همان ستون هستش . مثلا در فایلی که شما زحمتش رو کشیدید دیتاهای ستون x1 در همان ستون بدون فضای خالی ذخیره بشه و همینطور X2 و X3 الی آخر. شما همه داده ها را در یک ستون مجتمع کردید .

[iranweld]

با سلام
متشکرم از وقتی که از این بابت گذاشتید . مورد نظر من حذف سلول های خالی در همان ستون هستش . مثلا در فایلی که شما زحمتش رو کشیدید دیتاهای ستون x1 در همان ستون بدون فضای خالی ذخیره بشه و همینطور X2 و X3 الی آخر. شما همه داده ها را در یک ستون مجتمع کردید .

فایل رو بررسی بفرمایید

Sub TEST()

K1 = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column

K2 = 2

Dim LIST1 As New Collection

For J = 1 To K1

Z1 = Cells(Rows.Count, J).End(xlUp).Row

For I = 2 To Z1

If Cells(I, J) <> "" Then

LIST1.Add Cells(I, J)

End If

Next I



For X = 1 To LIST1.Count

Cells(X + 1, J) = LIST1.Item(X)

Next

Range(Cells(LIST1.Count + 2, J), Cells(Z1, J)).ClearContents

Set LIST1 = Nothing


Next J


End Sub 

[morteza71]

تی دست درد نکنه هم استانی . البته من با تغییر همون کد قبلی شما تونستم به نوعی به خواسته ام برسم و الحق و الانصاف کد های شما چیز دیگه ای هستش . سالم و تندرست باشیذ . خدا تی همراه