将工作簿中的命名范围及其值的导入/导出导出为.csv
我有一个.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 这将从CSV中读取值 – 提供命名范围和CSV中的值是相同的大小和单个列。
在我的示例代码中，CSV有两个不同的命名范围：A1：A3保持“NamedRangeA”，B1：B3保存值，A4：A6保留“NamedRangeB”和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中的第一张（也是唯一）工作表。 也已经摆脱了Xvariables意识到它不会工作，如果你的命名范围不是。 现在将下一个值放在您命名的范围中的下一个空单元格。
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