ذخيره يک ستون حاوي فرمول به فايل تکست

[rezamelika2]

چطور مي شه يک ستون که داراي فرمول هست (يک سري اعداد رو از شيت ديگر دريافت مي کنه ) با ماژول روي دسک تاپ با پسوند txt ذخيره کرد؟

[rasools13]

چطور مي شه يک ستون که داراي فرمول هست (يک سري اعداد رو از شيت ديگر دريافت مي کنه ) با ماژول روي دسک تاپ با پسوند txt ذخيره کرد؟

با استفاده از ماکروی ذیل میتونید این کار رو انجام بدید.به این صورت
1- انتخاب محدوده مورد نظر جهت استخراج
2- کلیک بر روی دکمه
3- انتخاب مسیر ذخیره فایل
در پایان فایلی با نام MyExport و با فرمت CSV.* در مسیر انتخابی ایجاد میشود که میتوانید آن را با Notepad باز کرده و یا به فرمت های دلخواه (txt.*) ذخیره کنید.


یک نمونه در فایل پیوست قرار داده شده

Sub Macro1()
'
' Macro1 Macro
'

'
    Dim myFile As String
    Dim rng As Range
    Dim rngVal As Variant
    Dim i, j As Integer
    myFile = GetFolder() & "\" & "MyExport.csv"
    Set rng = Selection
    Open myFile For Output As #1
    
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            rngVal = rng.Cells(i, j).Value
            If j = rng.Columns.Count Then
            Write #1, rngVal
            Else
                Write #1, rngVal,
            End If
        Next j
    Next i
    Close #1
End Sub
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function 

[rezamelika2]

با استفاده از ماکروی ذیل میتونید این کار رو انجام بدید.به این صورت
1- انتخاب محدوده مورد نظر جهت استخراج
2- کلیک بر روی دکمه
3- انتخاب مسیر ذخیره فایل
در پایان فایلی با نام MyExport و با فرمت CSV.* در مسیر انتخابی ایجاد میشود که میتوانید آن را با Notepad باز کرده و یا به فرمت های دلخواه (txt.*) ذخیره کنید.
[ATTACH=CONFIG]14060[/ATTACH]

یک نمونه در فایل پیوست قرار داده شده

Sub Macro1()
'
' Macro1 Macro
'

'
    Dim myFile As String
    Dim rng As Range
    Dim rngVal As Variant
    Dim i, j As Integer
    myFile = GetFolder() & "\" & "MyExport.csv"
    Set rng = Selection
    Open myFile For Output As #1
    
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            rngVal = rng.Cells(i, j).Value
            If j = rng.Columns.Count Then
            Write #1, rngVal
            Else
                Write #1, rngVal,
            End If
        Next j
    Next i
    Close #1
End Sub
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function 

ممنون از راهنمایی تون
لطفا فایل پیوست را مشاهده نمایید

[rasools13]

ممنون از راهنمایی تون
لطفا فایل پیوست را مشاهده نمایید

فایل پیوستی نفرستادین
اگر هم منظورتون فایل پیوست خودم بود ممکنه هنگام دانلود مشکل پیش بیاد باز نشه اگر با winrar ان را repair کنید درست میشه

[rezamelika2]

فایل پیوست شد

[rasools13]

فایل پیوست شد

همان ماکروی قبلی دقیقا خروجی ش همین چیزیه که شما میخواهین... خروجی که شما میخواین قراردادن عناصر هر ردیف در یک سطر هست که با کاما - ، - جدا شده با شین و این همان فایل های Comma Sepreated Value یا CSV.* است. که میتوانید آن را با Notepad باز کنید.

کد ذیل مستقیما قایل را در دسکتاپ ذخیره میکند.. فقط YourUserAccount را تغییر دهید

Sub Macro1()
'
' Macro1 Macro
'

'
    Dim myFile As String
    Dim rng As Range
    Dim rngVal As Variant
    Dim i, j As Integer
    myFile = "C:\Users\YourUserAccount\Desktop" & "\" & "MyExport.csv"
    Set rng = Selection
    Open myFile For Output As #1
    
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            rngVal = rng.Cells(i, j).Value
            If j = rng.Columns.Count Then
            Write #1, rngVal
            Else
                Write #1, rngVal,
            End If
        Next j
    Next i
    Close #1
End Sub