将命名范围及其值从工作簿导入/导出到.csv [英] Import/export named ranges and their values to and from workbook to .csv

问题描述

我有一个.csv有两列：colA有命名范围和colB有值。

I have a .csv with two columns: colA has named ranges and colB has the values.

现在我需要导入的值从.csv和分配它们到在多个工作表中存在的工作簿中的命名范围。另外，我需要以相同的方式导出相同。即工作簿具有命名范围和显然一些关联值。

Now I need to import the values from the .csv and assign them to the named ranges in the workbook present in multiple sheets. Also I need to export the same in the same manner. i.e. A workbook has named ranges and obviously some associated values.

有没有一种方式以相同的格式导出，以便我以后可以使用它导入？

Is there a way to export in the same format so that I can use it to import them later?

对于导入，我修改了以下答案提供的代码，但仍未成功：

For import I modified the code provided as an answer below but still unsuccessful:

Option Explicit
Sub impdata()
'This is to import data from csv to xlsm

Dim MyCSV As Workbook
Dim filename As String
Dim curfilename As String
Dim MyRange As Range
Dim MyCell As Range
Dim x As Long
Dim y As Workbook

curfilename = ThisWorkbook.Name
filename = Application.GetOpenFilename

Set y = Workbooks(curfilename)

Application.ScreenUpdating = False

    Set MyCSV = Workbooks.Open(filename)
    Set MyRange = MyCSV.Worksheets("Import").Range("B2:B7") 

    x = 1
    For Each MyCell In MyRange.Cells
        Range(ThisWorkbook.Names(MyCell.Offset(, -1).Value)).Cells(x) = MyCell.Value     'Method "Range_of_object" Global failed
        x = x + 1
    Next MyCell

MyCSV.Close SaveChanges:=False
Application.DisplayAlerts = False


End Sub

推荐答案

这将从CSV中读取值 - 提供命名范围和CSV中的值是相同大小和单列。

This will read the values in from the CSV - providing the Named Range and values in the CSV are the same size and a single column.

在我的示例代码中，CSV有两个不同的命名范围 - A1：A3 hold'NamedRangeA'和B1：B3保存值，A4：A6 hold'NamedRangeB' B4：B6保持这些值。在Excel工作簿中有两个命名范围，都是3行乘1列。

In my example code the CSV has two different named ranges - A1:A3 hold 'NamedRangeA' and B1:B3 hold the values, A4:A6 hold 'NamedRangeB' and B4:B6 hold the values. There are two named ranges in the Excel workbook, both 3 rows by 1 column.

Sub ReadIn()

    Dim MyCSV As Workbook
    Dim MyRange As Range
    Dim MyCell As Range
    Dim x As Long

    Set MyCSV = Workbooks.Open("C:\Documents and Settings\crladmin.ADMINNOT\Desktop\New Folder\NamesToRanges.CSV")
    Set MyRange = MyCSV.Worksheets("NamesToRanges").Range("A1:B6")

    x = 1
    For Each MyCell In MyRange.Columns(2).Cells
        Range(ThisWorkbook.Names(MyCell.Offset(, -1).Value)).Cells(x) = MyCell.Value
        x = x + 1
    Next MyCell

End Sub

编辑： / strong>
重新编写代码：

Have rewritten the code:

现在会要求您输入CSV的位置，它将使用第一个CSV。
也摆脱了 X 变量，如果你的命名范围没有，它将无法工作。现在将下一个值放入您命名范围中的下一个空单元格。

It will now ask you for the location of your CSV, it will use the first (and only) sheet in the CSV. Have also got rid of the X variable as realised it wouldn't work if your named ranges weren't. Will now put the next value in the next empty cell in your named range.

Sub impdata()

    Dim MyCSV As Workbook
    Dim MyCSVPath As String
    Dim MyRange As Range
    Dim MyCell As Range
    Dim MyNextCell As Range
    Dim MyNamedRange As Range

    MyCSVPath = GetFile

    If MyCSVPath <> "" Then
        Set MyCSV = Workbooks.Open(MyCSVPath)
        Set MyRange = MyCSV.Worksheets(1).Range("B2:B7") 'Ensure B2:B7 is where your values are.

        ThisWorkbook.Activate
        For Each MyCell In MyRange.Cells

            'Get a reference to the named range.
            Set MyNamedRange = Range(ThisWorkbook.Names(MyCell.Offset(, -1).Value))

            'Find the next empty cell in the named range.
            Set MyNextCell = MyNamedRange.Cells(MyNamedRange.Cells.Count).End(xlUp).Offset(1)

            'If the next empty cell is above the named range, then set
            'it to the first cell in the range.
            If MyNextCell.Row < MyNamedRange.Cells(1).Row Then
                Set MyNextCell = MyNamedRange.Cells(1)
            End If

            'Place the value in the range.
            MyNextCell = MyCell.Value

        Next MyCell
    End If

    MyCSV.Close False

End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetFile
' Date      : 13/11/2013
' Purpose   : Returns the full file path of the selected file
' To Use    : vFile = GetFile()
'           : vFile = GetFile("S:\Bartrup-CookD\Customer Services Phone Reports")
'---------------------------------------------------------------------------------------
Function GetFile(Optional startFolder As Variant = -1) As Variant
    Dim fle As FileDialog
    Dim vItem As Variant
    Set fle = Application.FileDialog(msoFileDialogFilePicker)
    With fle
        .Title = "Select a File"
        .AllowMultiSelect = False
        .Filters.Add "Comma Separate Values", "*.CSV", 1
        If startFolder = -1 Then
            .InitialFileName = Application.DefaultFilePath
        Else
            If Right(startFolder, 1) <> "\" Then
                .InitialFileName = startFolder & "\"
            Else
                .InitialFileName = startFolder
            End If
        End If
        If .Show <> -1 Then GoTo NextCode
        vItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = vItem
    Set fle = Nothing
End Function

这篇关于将命名范围及其值从工作簿导入/导出到.csv的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！