从工作簿到.csv导入/导出命名范围及其值

Question

我有一个包含两列的.csv：colA已命名范围，colB具有值。

现在我需要从.csv导入值并将它们分配给多个工作表中存在的工作簿中的命名范围。我也需要以相同的方式导出相同的内容。即工作簿已命名范围，显然还有一些相关值。

有没有办法以相同的格式导出，以便我以后可以用它来导入它们？

对于导入，我修改了下面作为答案提供的代码，但仍然不成功：

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

Answer 1

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

在我的示例代码中，CSV有两个不同的命名范围 - A1：A3 hold＆＃39; NamedRangeA＆＃39;和B1：B3持有值，A4：A6持有＆＃39; NamedRangeB＆＃39;和B4：B6保持值。 Excel工作簿中有两个命名范围，均为3行乘1列。

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

希望能指出你正确的方向 - 现在只需要找出一个CSV的读数。

修改 重写了代码：

现在它将询问您CSV的位置，它将使用CSV中的第一张（也是唯一的）工作表。 还删除了 X 变量，因为如果你的命名范围不是，它就不会起作用。现在将下一个值放在命名范围的下一个空单元格中。

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