マクロの実行は、それが自動的に我々はそれをしたいフォーマットに、我々はそれを受け取る形式からデータをフォーマットし、私は（少なくとも私にとっては）長いマクロを書かれている

大きなファイルが破損します。マクロの実行は、それが自動的に我々はそれをしたいフォーマットに、我々はそれを受け取る形式からデータをフォーマットし、私は（少なくとも私にとっては）長いマクロを書かれている

それは、データの量が少ないシート上では完全に機能します。しかし、大きなシート（300,000セル）で実行すると、ブックが破損します。クリップボードやメモリの問題（値を貼り付けるか列を削除するときに何かを破損しないようにするには）が唯一のエラーです。何か特別な理由があるかどうか疑問に思っていましたか？

ITの人が説明することを拒否理由のために、私は32ビットのExcelを使用するように強制しています、それを追加することが重要であるかもしれません...

Sub Macro2() 
' 
' Macro2 Macro 
' 

' Dialogue boxes 

                    'Definitions 
                    'NonYearColsString = Column Letter 
                    'NonYearCols   = Column Number 
                    'YearCol    = Column with Years in 
                    'LastYear    = Last year with data 
                    'FirstYear    = First Year with Data 
                    'r       =Last Row with Data 
                    'Ready     = yes/no ready to proceed 
                    'Nexxxtsheet   = Name of next sheet as string 
                    'Numberofwhatever = Number of Immigrants/emigrants/Stocks etc 
                    'YearColStr    = Column with Years in as a Letter 
                    't       = Variable wait time to allow processing. Dependent on r 
                    'NYears     = Number of years in Dataset 
                    'Step     = Integer value of r/10 


Line69: 

Range("A1").Select 

Dim Ready As String 
Ready = InputBox("You need a few things for this to work: You must - know the range of years, have an empty sheet preceeding the data, and know the column header for the last field that is not a year. NOTE: If the data seems bizarre - recalculate the formulae before crying. If recalculating doesn't work, go back to crying... Input Yes to continue; No to cancel; Check to go to check the data you need.", , "Yes") 
If Ready = "Yes" Or Ready = "yes" Or Ready = "y" Or Ready = "Y" Then GoTo Line0 
If Ready = "Check" Or Ready = "check" Then GoTo Line10 
If Ready = "No" Or Ready = "no" Or Ready = "n" Or Ready = "N" Then GoTo Line100 

Line10: 
Sheets(ActiveSheet.Index + 1).Select 
Range("A1").Select 

Line666: 

Dim chill As String 
chill = InputBox("Enter go to move to the end of the spreadsheet to see all the values, leave it blank to go back to the main menu") 
If chill = "go" Or chill = "Go" Or chill = "GO" Then GoTo Line999 
If chill = "" Then GoTo Line333 

Line999: 
Selection.End(xlToRight).Select 
chill = InputBox("Enter go to move to the end of the spreadsheet to see all the values, leave it blank to go back to the main menu") 
If chill = "go" Or chill = "Go" Or chill = "GO" Then GoTo Line999 
If chill = "" Then GoTo Line333 

Line333: 

Sheets(ActiveSheet.Index - 1).Select 
GoTo Line69 




Line0: 
Dim NonYearColsString As String 
Dim NonYearCols As Integer 
Line1: 
    NonYearColsString = InputBox("Input last Column Letter that does not contain a year", , "d") 
Range("ZZ67").Value = NonYearColsString 
    If NonYearColsString = "" Then GoTo Line100 
    If NonYearColsString = "a" Or NonYearColsString = "A" Then NonYearCols = 1 
    If NonYearColsString = "b" Or NonYearColsString = "B" Then NonYearCols = 2 
    If NonYearColsString = "c" Or NonYearColsString = "C" Then NonYearCols = 3 
    If NonYearColsString = "d" Or NonYearColsString = "D" Then NonYearCols = 4 
    If NonYearColsString = "e" Or NonYearColsString = "E" Then NonYearCols = 5 
    If NonYearColsString = "f" Or NonYearColsString = "F" Then NonYearCols = 6 
    If NonYearColsString = "g" Or NonYearColsString = "G" Then NonYearCols = 7 
    If NonYearColsString = "h" Or NonYearColsString = "H" Then NonYearCols = 8 
    If NonYearColsString = "i" Or NonYearColsString = "I" Then NonYearCols = 9 
    If NonYearColsString = "j" Or NonYearColsString = "J" Then NonYearCols = 10 

Line33: 

Dim YearCol As Integer 
YearCol = NonYearCols + 2 

Dim YearColStr As String 
If YearCol = "1" Then YearColStr = "A" 
If YearCol = "2" Then YearColStr = "B" 
If YearCol = "3" Then YearColStr = "C" 
If YearCol = "4" Then YearColStr = "D" 
If YearCol = "5" Then YearColStr = "E" 
If YearCol = "6" Then YearColStr = "F" 
If YearCol = "7" Then YearColStr = "G" 
If YearCol = "8" Then YearColStr = "H" 
If YearCol = "9" Then YearColStr = "I" 
If YearCol = "10" Then YearColStr = "J" 

GoToLine88: 

Line88: 

Dim FirstYear As String 
Line2: 
    FirstYear = InputBox("Input the first year of data available", , "2000") 
Range("ZZ68").Value = FirstYear 
    If FirstYear = "" Then GoTo Line100 

Dim LastYear As String 
Line3: 
    LastYear = InputBox("Input the last year of data available", , "2015") 
Range("ZZ69").Value = LastYear 
    If LastYear = "" Then GoTo Line100 

Dim NYears As Integer 
NYears = LastYear - FirstYear + 1 

Dim Numberofwhatever As String 
Line4: 
    Numberofwhatever = InputBox("Input the title of the Field e.g Number of Immigrants", , "Number of Immigrants") 
    If Numberofwhatever = "" Then GoTo Line100 


    ActiveCell.FormulaR1C1 = "Counter" 
    Range("A2").Select 
    ActiveCell.FormulaR1C1 = "1" 
    Range("A3").Select 
    Sheets(ActiveSheet.Index + 1).Select 
    ActiveSheet.Cells(1, NonYearCols).Select 
    Range(Selection, Selection.End(xlToLeft)).Select 
    Selection.Copy 
    Sheets(ActiveSheet.Index - 1).Select 
    Range("B1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Sheets(ActiveSheet.Index + 1).Select 
    Columns("A:A").Select 
    Application.CutCopyMode = False 


    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("A1").Select 
    ActiveCell.FormulaR1C1 = "Counter" 
    Range("A2").Select 
    ActiveCell.FormulaR1C1 = "1" 
    Range("A3").Select 
    ActiveCell.FormulaR1C1 = "2" 
    Range("A4").Select 
    ActiveCell.FormulaR1C1 = "3" 
    Range("A2:A4").Select 
    Selection.AutoFill Destination:=Range("A2:A100000") 
    Range("A2:A10000").Select 
    Range("A2").Select 

    'Once the counter is in place; r can be defined 

    Range("C1").Select 
    Selection.End(xlDown).Select 
    Selection.End(xlToLeft).Select 
    Selection.Copy 
    DoEvents 
    Sheets(ActiveSheet.Index - 1).Select 
    Range("J15").Select 
    ActiveSheet.Paste 
    DoEvents 
    Range("J15").Value = Range("J15").Value * NYears 
    DoEvents 

    Dim r As Long 

    r = Range("J15").Value 

    Dim t As Integer 

    If r < 50000 Then t = "5" 
    If 50000 < r < 100000 Then t = "7" 
    If 100000 < r < 200000 Then t = "15" 
    If 200000 < r < 300000 Then t = "25" 
    If r > 300000 Then t = "35" 

    Dim Step As Long 

    Step = r \ 10 

    Range("ZZ64").Select 
    ActiveCell.FormulaR1C1 = "=NextSheetName()" 
    Dim nexxxtsheet As String 
    nexxxtsheet = Range("ZZ64").Text 
    Range("ZZ65").Select 
    ActiveCell.FormulaR1C1 = nexxxtsheet 

    If NonYearCols = 1 Then GoTo Line7769 


    ActiveSheet.Cells(1, YearCol).Select 
    ActiveCell.FormulaR1C1 = "Year" 
    Selection.Offset(1, 0).Select 
    ActiveCell.FormulaR1C1 = FirstYear 
    Selection.Offset(1, 0).Select 
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C=" & LastYear & "," & FirstYear & ",R[-1]C+1)" 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(3, YearCol), Cells(r + 1, YearCol)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(3, YearCol), Cells(r + 1, YearCol)).Calculate 
    Range("A3").Select 
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[" & YearCol - 1 & "]=" & LastYear & ",R[-1]C+1,R[-1]C)" 
    Range("A3").Select 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(3, 1), Cells(r + 1, 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(3, 1), Cells(r + 1, 1)).Calculate 

    Range("B2").Select 
    ActiveCell.Formula = _ 
     "=OFFSET(" & nexxxtsheet & "$A$1,MATCH($A2," & nexxxtsheet & "$A$2:$A$100000,0),MATCH(B$1," & nexxxtsheet & "$B$1:$ZZ$1,0))" 
    Range("B2").Select 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(2, 2), Cells(2, NonYearCols + 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(2, 2), Cells(2, NonYearCols + 1)).Calculate 
    DoEvents 
    Range(Cells(2, 2), Cells(2, NonYearCols + 1)).Select 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(2, 2), Cells(Step, NonYearCols + 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(2, 2), Cells(Step, NonYearCols + 1)).Calculate 
    DoEvents 
    Selection.End(xlDown).Select 
     Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
     Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step, 2), Cells(Step * 2, NonYearCols + 1)), Type:=xlFillDefault 
     ActiveSheet.UsedRange.Range(Cells(Step, 2), Cells(Step * 2, NonYearCols + 1)).Calculate 
     DoEvents 
     Selection.End(xlDown).Select 
      Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
      Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 2, 2), Cells(Step * 3, NonYearCols + 1)), Type:=xlFillDefault 
      ActiveSheet.UsedRange.Range(Cells(Step * 2, 2), Cells(Step * 3, NonYearCols + 1)).Calculate 
      DoEvents 
      Selection.End(xlDown).Select 
       Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
       Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 3, 2), Cells(Step * 4, NonYearCols + 1)), Type:=xlFillDefault 
       ActiveSheet.UsedRange.Range(Cells(Step * 3, 2), Cells(Step * 4, NonYearCols + 1)).Calculate 
       DoEvents 
       Selection.End(xlDown).Select 
        Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
        Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 4, 2), Cells(Step * 5, NonYearCols + 1)), Type:=xlFillDefault 
        ActiveSheet.UsedRange.Range(Cells(Step * 4, 2), Cells(Step * 5, NonYearCols + 1)).Calculate 
        DoEvents 
        Selection.End(xlDown).Select 
         Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
         Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 5, 2), Cells(Step * 6, NonYearCols + 1)), Type:=xlFillDefault 
         ActiveSheet.UsedRange.Range(Cells(Step * 5, 2), Cells(Step * 6, NonYearCols + 1)).Calculate 
         DoEvents 
         Selection.End(xlDown).Select 
          Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
          Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 6, 2), Cells(Step * 7, NonYearCols + 1)), Type:=xlFillDefault 
          ActiveSheet.UsedRange.Range(Cells(Step * 6, 2), Cells(Step * 7, NonYearCols + 1)).Calculate 
          DoEvents 
          Selection.End(xlDown).Select 
           Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
           Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 7, 2), Cells(Step * 8, NonYearCols + 1)), Type:=xlFillDefault 
           ActiveSheet.UsedRange.Range(Cells(Step * 7/10, 2), Cells(Step * 8, NonYearCols + 1)).Calculate 
           DoEvents 
           Selection.End(xlDown).Select 
            Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
            Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 8, 2), Cells(Step * 9, NonYearCols + 1)), Type:=xlFillDefault 
            ActiveSheet.UsedRange.Range(Cells(Step * 8, 2), Cells(Step * 9, NonYearCols + 1)).Calculate 
            DoEvents 
            Selection.End(xlDown).Select 
             Range(ActiveCell, ActiveCell.Offset(0, NonYearCols - 1)).Select 
             Selection.AutoFill Destination:=ActiveSheet.Range(Cells(Step * 9, 2), Cells(r + 1, NonYearCols + 1)), Type:=xlFillDefault 
             ActiveSheet.UsedRange.Range(Cells(Step * 9, 2), Cells((r + 1), NonYearCols + 1)).Calculate 
             DoEvents 
             Selection.End(xlDown).Select 
           ActiveCell.Select 






    Cells(1, YearCol + 1).Select 
    ActiveCell.FormulaR1C1 = Numberofwhatever 
    Selection.Offset(1, 0).Select 
    ActiveCell.Formula = _ 
     "=OFFSET(" & nexxxtsheet & "$A$1,MATCH(A2," & nexxxtsheet & "$A$2:$A$100000,0),MATCH($" & YearColStr & ":" & YearColStr & "," & nexxxtsheet & "$B$1:$ZZ$1,0))" 
    Selection.AutoFill Destination:=ActiveSheet.UsedRange.Range(Cells(2, YearCol + 1), Cells(r + 1, YearCol + 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(2, YearCol + 1), Cells(r + 1, YearCol + 1)).Calculate 
    DoEvents 


    Range(Cells(1, 1), Cells(r + 1000, 1)).Select 
    Selection.Copy 
    DoEvents 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Range(Cells(1, 2), Cells(r + 1000, 2)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 3), Cells(r + 1000, 3)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 4), Cells(r + 1000, 4)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 5), Cells(r + 1000, 5)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 6), Cells(r + 1000, 6)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 7), Cells(r + 1000, 7)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 8), Cells(r + 1000, 8)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 9), Cells(r + 1000, 9)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 10), Cells(r + 1000, 10)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 11), Cells(r + 1000, 11)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range("J15").Value = "" 
    Range("A:A").Delete 
    Sheets(ActiveSheet.Index + 1).Select 
    Range("A:A").Delete 
    Sheets(ActiveSheet.Index - 1).Select 
    Range("ZZ64:ZZ80").Value = "" 
    ActiveSheet.Range(Cells(r + 2, 1), Cells(1048576, 1000)).Value = "" 

GoTo Line100 

Line7769: 

    ActiveSheet.Cells(1, YearCol).Select 
    ActiveCell.FormulaR1C1 = "Year" 
    Selection.Offset(1, 0).Select 
    ActiveCell.FormulaR1C1 = FirstYear 
    Selection.Offset(1, 0).Select 
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C=" & LastYear & "," & FirstYear & ",R[-1]C+1)" 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(3, YearCol), Cells(r + 1, YearCol)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(3, YearCol), Cells(r + 1, YearCol)).Calculate 
    Range("A3").Select 
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[" & YearCol - 1 & "]=" & LastYear & ",R[-1]C+1,R[-1]C)" 
    Range("A3").Select 
    Selection.AutoFill Destination:=ActiveSheet.Range(Cells(3, 1), Cells(r + 1, 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(3, 1), Cells(r + 1, 1)).Calculate 


    Range("B2").Select 
    ActiveCell.Formula = _ 
     "=OFFSET(" & nexxxtsheet & "$A$1,MATCH($A2," & nexxxtsheet & "$A$2:$A$100000,0),MATCH(B$1," & nexxxtsheet & "$B$1:$ZZ$1,0))" 
    Range("B2").Calculate 
    DoEvents 
    Selection.AutoFill Destination:=ActiveSheet.UsedRange.Range(Cells(2, 2), Cells(r + 1, 2)), Type:=xlFillDefault 


    Cells(1, YearCol + 1).Select 
    ActiveCell.FormulaR1C1 = Numberofwhatever 
    Selection.Offset(1, 0).Select 
    ActiveCell.Formula = _ 
     "=OFFSET(" & nexxxtsheet & "$A$1,MATCH(A2," & nexxxtsheet & "$A$2:$A$100000,0),MATCH($" & YearColStr & ":" & YearColStr & "," & nexxxtsheet & "$B$1:$ZZ$1,0))" 
    Selection.AutoFill Destination:=ActiveSheet.UsedRange.Range(Cells(2, YearCol + 1), Cells(r + 1, YearCol + 1)), Type:=xlFillDefault 
    ActiveSheet.UsedRange.Range(Cells(2, YearCol + 1), Cells(r + 1, YearCol + 1)).Calculate 
    DoEvents 


    Range(Cells(1, 1), Cells(r + 1000, 1)).Select 
    Selection.Copy 
    DoEvents 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Range(Cells(1, 2), Cells(r + 1000, 2)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 3), Cells(r + 1000, 3)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 4), Cells(r + 1000, 4)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 5), Cells(r + 1000, 5)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 6), Cells(r + 1000, 6)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 7), Cells(r + 1000, 7)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 8), Cells(r + 1000, 8)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 9), Cells(r + 1000, 9)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 10), Cells(r + 1000, 10)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range(Cells(1, 11), Cells(r + 1000, 11)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues 
    DoEvents 
    Range("J15").Value = "" 
    Range("A:A").Delete 
    Sheets(ActiveSheet.Index + 1).Select 
    Range("A:A").Delete 
    Sheets(ActiveSheet.Index - 1).Select 
    Range("ZZ64:ZZ80").Value = "" 
    ActiveSheet.Range(Cells(r + 2, 1), Cells(1048576, 1000)).Value = "" 

Line100: 
End Sub

メインのコードは、関数のNextSheetNameに呼び出します。

Function NextSheetName(Optional WS As Worksheet = Nothing) As String 
    Application.Volatile True 
    Dim S As String 
    Dim Q As String 
    Dim P As String 
    If IsObject(Application.Caller) = True Then 
     Set WS = Application.Caller.Worksheet 
     If WS.Index = WS.Parent.Sheets.Count Then 
      With Application.Caller.Worksheet.Parent.Worksheets 
       Set WS = .Item(1) 
      End With 
     Else 
      Set WS = WS.Next 
     End If 
     If InStr(1, WS.Name, " ", vbBinaryCompare) > 0 Then 
      Q = "'" 
     Else 
      Q = vbNullString 
     End If 
    Else 
     If WS Is Nothing Then 
      Set WS = ActiveSheet 
     End If 
     If WS.Index = WS.Parent.Worksheets.Count Then 
      With WS.Parent.Worksheets 
       Set WS = .Item(1) 
      End With 
     Else 
      Set WS = WS.Next 
     End If 
     Q = vbNullString 
    End If 
    P = "!" 
    NextSheetName = Q & WS.Name & Q & P 
End Function

説明：NextSheetName（オンラインで見つける;ない私のオリジナル作品は）それが名を指定せずにマクロで呼び出すことができますので、次のシートの名前を返します。

https://i.stack.imgur.com/udi14.png

そして、この形式に変換します：全体としてマクロがこの形式でデータを取得

https://i.stack.imgur.com/CskpH.png

Iは、2枚のCSVバージョン、その腐敗の最初に含まれていますファイル、そのうちの2番目は正常に動作します。残念ながら、私の職場はファイル共有サイトを禁止していますので、より便利な形式でアップロードすることはできません。

2つ以上のリンクを投稿するには10の評判が必要です。 paste.ee％/ P/e1H9x

を作品1：：ちょうどリンク

破損1に到達するために％sの削除paste.ee％/ P/NmAFn

を！！これを実行したい場合は、自動計算をオフにすることを強くお勧めします。

お手数をおかけしていただきありがとうございます。

ルーカス

出典

2016-10-14 Lukas Ljungstrom

まずはSOのhttp://stackoverflow.com/help/askingの質問を参照してください。通常、問題を特定して助けてくれるコードが必要です。 – Blenikos

コードが表示された場合にのみ、エラーを見つけることができます。だから、ポストにコードを入れるというあなたの当初の思想に合っていた。そうするようにして、Excelバージョン、エラーが発生した行、特定のエラーメッセージ（該当する場合）、問題の再現のサンプルデータ（コード付き）も含めてください。 – Ralph

また、あなたの質問で言及した別のポイント。 vbaでは、コピーペーストの使用を一般的に避けてください（遅く、何の理由もなく膨大なリソースが必要です）。おそらくあなたが言及したクリップボードとメモリの問題は、大きなxlファイルでデータが壊れている理由です。 – Blenikos

これは私が正しくあなたを理解していた場合、あなたが達成しようとしている何をすべきかすべきで、あなたの二つのサンプルを見た後。コードは最適ではありませんが、エラーチェックは含まれていませんが、うまくいけばあなたを始められます。

Option Explicit 

Sub Main() 
    Dim wS As Worksheet, wT As Worksheet 
    Dim rS As Range, rT As Range, rY As Range 
    Dim v 
    Dim lRow As Long 'last used row 
    Dim Cnt As Long 'source row cntr 
    Dim FCol As Long 
    Dim LCol As Long 

' ------change these 2 rows to suit-------- 
    Const FDATE As Long = 2000 'first year 
    Const LDATE As Long = 2015 'last year 
'------------------------------------------ 

    Set wS = ThisWorkbook.Worksheets("e1H9x") 'source sheet, chg to suit 
    Set wT = ThisWorkbook.Worksheets("Modified") 'chg to suit 

    On Error GoTo errTrap 
' establish year columns 
    FCol = wS.Rows(1).Cells.Find(FDATE, , xlValues, xlWhole, , , False).Column 
    LCol = wS.Rows(1).Cells.Find(LDATE, , xlValues, xlWhole, , , False).Column 

    wT.Select: wT.Range("a1").Select 

    Application.ScreenUpdating = False 

' add heading if blank sheet 
    lRow = LastRow(wT) 
    If lRow = 1 And IsEmpty(wT.Cells(1, 1)) Then 'assume blank sheet 
    Set rY = wS.Range("a1").Resize(, FCol - 1) 
    addHeader wT, rY 
    End If 

    Set rS = wS.Range("A1", wS.Cells(wS.Rows.Count, 1).End(xlUp)) 'data height 
    Set rS = rS.Resize(, FCol - 1) 'columns 1 to Gender 
    Set rY = rS.Offset(, FCol - 1).Resize(, LCol + 1 - FCol) 'years columns 

    lRow = lRow + 1 

    For Cnt = 2 To rS.Rows.Count 'skip over heading row 
    v = rS.Rows(Cnt) 
    wT.Cells(lRow, 1).Resize(, FCol - 1) = v 
    rY.Rows(1).Copy 'years 
    wT.Cells(lRow, FCol).PasteSpecial xlPasteValues, , , True 
    rY.Rows(Cnt).Copy 'numbers 
    wT.Cells(lRow, FCol + 1).PasteSpecial xlPasteValues, , , True 
    wT.Cells(lRow, 1).Resize(rY.Columns.Count, FCol - 1).FillDown 
    lRow = lRow + rY.Columns.Count 'next row 
    If (Cnt Mod 1000) = 0 Then DoEvents 'every 1000 iterations 
    Application.StatusBar = Cnt 
    Next Cnt 

    wT.Cells(1, 1).Select 
errTrap: 
    Application.CutCopyMode = False 
End Sub 

Function LastRow(w As Worksheet) As Long 
' checks cells in column 'A' 
    Dim c As Range 
    Set c = w.Cells(w.Rows.Count, 1).End(xlUp) 
    LastRow = c.Row 
End Function 

Sub addHeader(w As Worksheet, r As Range) 
    Dim rT As Range 
    Set rT = w.Range("a1").Resize(, r.Columns.Count) 
    rT.Value = r.Value 
    rT(1, 1).Offset(, rT.Columns.Count).Value = "Year" 
    rT(1, 1).Offset(, rT.Columns.Count + 1).Value = "Number of Immigrants" 
End Sub

出典

2016-10-16 06:36:40 DaveU

ありがとう@DaveU！ –

私は試してみましたが、すばやく遊んだ後、私はそれを動作させることができました。標準化して、私が持っているシートのすべての構成で再生できるようにしました。どうもありがとうございました;私はあなたがこれをする時間を取ったことに非常に感謝しています。 –

クイック質問 - 「保存前にブックを再計算する」をオフにしました。これは、最適なマクロよりも少ないといっても、ブックが壊れていないことを意味していました。しかし、すべての公式が値として貼り付けられているので、私にはそれが違いを生むべきではないように思えます...なぜそれがですか？ –

マクロの実行は、それが自動的に我々はそれをしたいフォーマットに、我々はそれを受け取る形式からデータをフォーマットし、私は（少なくとも私にとっては）長いマクロを書かれている

答えて

関連する問題