Excel 根据单元格值剪切和插入

Question

在共享工作簿中，我收到有关以下内容的 1004 错误：“插入范围方法失败。”

我多年来一直使用以下代码。 （非共享模式）

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim wb As Workbook
Dim ws1 As Worksheet
Dim x As Integer
Dim y As Integer
Dim score As Long
Dim scoreRow As Long
Set wb = ActiveWorkbook
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And 
  Target.Row <= 9 Then
  Set ws1 = Worksheets(1)
  For x = 10 To 19
    score = ws1.Cells(x, 14).Value
    scoreRow = x
      For y = x + 1 To 19
        If ws1.Cells(y, 14).Value > score Then
        score = ws1.Cells(y, 14).Value
        scoreRow = y
  End If 'strange... It looks to stay better after the next code line...
     Next y
 'Next x is missing, too...

If scoreRow <> x Then
  ws1.Cells(scoreRow, 13).Cut
  ws1.Cells(x, 13).Insert
  ws1.Cells(scoreRow, 14).Cut
  ws1.Cells(x, 14).Insert
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

任何调整共享工作簿的帮助都会很棒。 第 10 到 19 行仅包含我正在操作（排序）的数据

Answer 1

因此，您最终应该得到如下代码：

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Dim wb          As Workbook
    Dim ws1         As Worksheet
    Dim x           As Integer
    Dim y           As Integer
    Dim score       As Long
    Dim scoreRow    As Long
    Set wb = ActiveWorkbook
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And Target.Row <= 9 Then
        Set ws1 = Worksheets(1)

        For x = 10 To 19
            score = ws1.Cells(x, 14).Value
            scoreRow = x

            For y = x + 1 To 19

                If ws1.Cells(y, 14).Value > score Then
                    score = ws1.Cells(y, 14).Value
                    scoreRow = y
                End If    'strange... It looks to stay better after the next code line...

            Next y
            'Next x is missing, too...

            If scoreRow <> x Then
                ws1.Cells(scoreRow, 13).Cut
                ws1.Cells(x, 13).Insert
                ws1.Cells(scoreRow, 14).Cut
                ws1.Cells(x, 14).Insert
            End If

            ActiveWorkbook.Save
        Next

    End If

    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub