سؤال

وأنا مجرد بداية ليغوص في VBA، ولقد ضرب قليلا من حاجز.

ولدي ورقة مع 50+ الأعمدة، 900+ صفوف من البيانات. ولست بحاجة لإعادة حوالي 10 من هذه الأعمدة والتمسك بها في مصنف جديد.

وكيف يمكنني برمجيا تحديد كل الخلايا غير الفارغة في عمود من BOOK1، وتشغيله من خلال بعض الوظائف، وإسقاط النتائج في Book2؟

هل كانت مفيدة؟

المحلول

وكود VBA التالية يجب ان تحصل على انك بدأته. فإنه سيتم نسخ كافة البيانات في المصنف الأصلي إلى المصنف الجديد، ولكنها ستكون قد أضافت 1 إلى كل قيمة، وسيكون قد تم تجاهل كافة الخلايا الفارغة.

Option Explicit

Public Sub exportDataToNewBook()
    Dim rowIndex As Integer
    Dim colIndex As Integer
    Dim dataRange As Range
    Dim thisBook As Workbook
    Dim newBook As Workbook
    Dim newRow As Integer
    Dim temp

    '// set your data range here
    Set dataRange = Sheet1.Range("A1:B100")

    '// create a new workbook
    Set newBook = Excel.Workbooks.Add

    '// loop through the data in book1, one column at a time
    For colIndex = 1 To dataRange.Columns.Count
        newRow = 0
        For rowIndex = 1 To dataRange.Rows.Count
            With dataRange.Cells(rowIndex, colIndex)

            '// ignore empty cells
            If .value <> "" Then
                newRow = newRow + 1
                temp = doSomethingWith(.value)
                newBook.ActiveSheet.Cells(newRow, colIndex).value = temp
                End If

            End With
        Next rowIndex
    Next colIndex
End Sub

و

Private Function doSomethingWith(aValue)

    '// This is where you would compute a different value
    '// for use in the new workbook
    '// In this example, I simply add one to it.
    aValue = aValue + 1

    doSomethingWith = aValue
End Function

نصائح أخرى

وأعرف أنني تأخرت جدا في هذا، ولكن هنا بعض العينات مفيدة:

'select the used cells in column 3 of worksheet wks
wks.columns(3).SpecialCells(xlCellTypeConstants).Select

أو

'change all formulas in col 3 to values
with sheet1.columns(3).SpecialCells(xlCellTypeFormulas)
    .value = .value
end with

لتجد الصف المستخدمة الماضي في العمود، لا تعتمد على LastCell، والتي لا يمكن الاعتماد عليها (أنه لا إعادة تعيين بعد حذف البيانات). بدلا من ذلك، وأنا استخدم سوميتينج مثل

 lngLast = cells(rows.count,3).end(xlUp).row

إذا كنت تبحث عن الصف الأخير من عمود، استخدام:

Sub SelectFirstColumn()
   SelectEntireColumn (1)
End Sub

Sub SelectSecondColumn()
    SelectEntireColumn (2)
End Sub

Sub SelectEntireColumn(columnNumber)
    Dim LastRow
    Sheets("sheet1").Select
    LastRow = ActiveSheet.Columns(columnNumber).SpecialCells(xlLastCell).Row

    ActiveSheet.Range(Cells(1, columnNumber), Cells(LastRow, columnNumber)).Select
End Sub

والأوامر الأخرى التي سوف تحتاج إلى الحصول على دراية هي نسخ ولصق الأوامر:

Sub CopyOneToTwo()
    SelectEntireColumn (1)
    Selection.Copy

    Sheets("sheet1").Select
    ActiveSheet.Range("B1").PasteSpecial Paste:=xlPasteValues
End Sub

وأخيرا، يمكنك الرجوع أوراق العمل في مصنفات أخرى باستخدام بناء الجملة التالي:

Dim book2
Set book2 = Workbooks.Open("C:\book2.xls")
book2.Worksheets("sheet1")

وهذا قد يكون تماما قبالة قاعدة، ولكن لا يمكن لك مجرد نسخ عمود بأكمله إلى جدول جديد ثم فرز العمود؟ أفترض أنك لا تحتاج إلى الحفاظ على سلامة النظام.

مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top