Невозможно сослаться на строку листа.Вернуть только данные строки текущего листа - PullRequest
0 голосов
/ 21 октября 2018

Я очень плохо знаком с VBA и программированием в целом.Я борюсь с этим фрагментом кода, где я хотел бы скопировать данные в строке A на листе «Система 1» и использовать их в моем списке проверки.Однако с этим текущим фрагментом кода кажется, что я получаю данные строк из моего текущего листа, а не из листа «Система 1»

Что я здесь не так делаю?Как лучше всего обращаться к другим листам для оптимизации скоростного листа Excel?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim range1 As Range, rng As Range
Set Sheet = Sheets("System 1")

Set range1 = Sheets("System 1").Range("A1:BB1")
Set rng = Range("M2")

With rng.Validation
     .Delete 'delete previous validation
     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Formula1:="='" & Name & "'!" & .range1.Address
End With

1 Ответ

0 голосов
/ 22 октября 2018

Этот код должен дать вам хорошее начало.Исправить и настроить в соответствии с вашими потребностями.Внимательно изучите настройки разделов кода.WSChange должно работать идеально, за исключением того, что, может быть, есть что-то странное в этих открытых переменных (вы всегда можете поместить их в процедуру ... и события ... Я не получаю их, но я скоро это сделаю.

Нельзя использовать диапазон из другого листа, чтобы использовать его в качестве диапазона проверки (аналогично условному форматированию, то есть для Excel 2003), поэтому необходимо указать имя для использования в качестве диапазона.

Этот элемент входит в модуль . Я просто не смог увидеть его на листе:

Option Explicit

Public strMain As String
Public Const cStrValList As String = "ValList" 'Validation List Name

Sub WSChange()

'-- Customize BEGIN --------------------
  'Name of the main worksheet containing the validation RANGE.
'***  The worksheet should be defined by name so that this script can be run ***
'***  from other worksheets (Do NOT use the Activesheet, if not necessary).  ***                                          ***
  Const cStrMain As String = "Main" 'If "" then Activesheet is used.
  'Name of the worksheet containing the validation LIST.
  Const cStrSys As String = "System 1"
'***  The next two constants should be defined as first cell ranges, so when ***
'***  adding new data, the last cell could be calculated again and the data  ***                                          ***
'***  wouldn't be 'out of bounds' (outside the range(s)).
  'Validation RANGE Address. Can be range or first cell range address.
  Const cStrMainRng As String = "$M$2" 'orig. "$M$2"
  'Validation LIST Range Address. Can be range or first cell range address.
  Const cStrSysRng As String = "$A$1" 'orig. "$A$1:$BB$1"
'-- Customize END ----------------------
  strMain = cStrMain

  Dim oWsMain As Worksheet
  Dim oRngMain As Range
  Dim oWsSys As Worksheet
  Dim oRngSys As Range
  Dim oName As Name

  Dim strMainRng As String
  Dim strMainLast As String
  Dim strSysRng As String
  Dim strSysLast As String
'---------------------------------------
  On Error GoTo ErrorHandler 'No error handling so far!
'---------------------------------------
'Main Worksheet
  If cStrMain <> "" Then 'When cStrMain is used as the worksheet name.
    Set oWsMain = ThisWorkbook.Worksheets(cStrMain)
   Else 'cStrMain = "", When ActiveSheet is used instead. Not recommended.
    Set oWsMain = ThisWorkbook.ActiveSheet
  End If
  With oWsMain
    If .Range(cStrMainRng).Cells.Count <> 1 Then
      strMainRng = cStrMainRng
     Else
      'Calculate Validation Range Last Cell Address
      strMainLast = .Range(Cells(Rows.Count, _
          .Range(cStrMainRng).Column).Address).End(xlUp).Address
      'Calculate Validation Range and assign to a range variable
      strMainRng = cStrMainRng & ":" & strMainLast 'First:Last
    End If
    Set oRngMain = .Range(strMainRng) 'Validation Range
  End With
'---------------------------------------
'System Worksheet
  Set oWsSys = Worksheets(cStrSys) 'Worksheet with Validation List
  With oWsSys
    If .Range(cStrSysRng).Cells.Count <> 1 Then
      strSysRng = cStrSysRng
     Else
      'Calculate Validation Range Last Cell Address
      strSysLast = .Range(Cells(.Range(cStrSysRng).Row, _
          Columns.Count).Address).End(xlToLeft).Address
      'Calculate Validation Range and assign to a range variable
      strSysRng = cStrSysRng & ":" & strSysLast 'First:Last
    End If
    Set oRngSys = .Range(strSysRng) 'Validation List Range
  End With
'---------------------------------------
'Name
  For Each oName In ThisWorkbook.Names
    If oName.Name = cStrValList Then
      oName.Delete
      Exit For 'If found, Immediately leave the For Each Next loop.
    End If
  Next
  ThisWorkbook.Names.Add Name:=cStrValList, RefersTo:="='" & cStrSys _
      & "'!" & strSysRng
  With oRngMain.Validation
      .Delete 'delete previous validation
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
          xlBetween, Formula1:="=" & cStrValList
  End With
'---------------------------------------
ProcedureExit:
  Set oRngMain = Nothing
  Set oRngSys = Nothing
  Set oWsSys = Nothing
  Set oWsMain = Nothing
Exit Sub
'---------------------------------------
ErrorHandler:
  'Handle Errors!
  MsgBox "An error has occurred.", vbInformation
GoTo ProcedureExit
'---------------------------------------
End Sub

И некоторые ' события ', не такхорошо, но у меня кончилось терпение.
Это на самом деле входит в рабочую таблицу ' Система 1 '. Возможно, вам следует найти что-то подобное для основного листа.

Option Explicit

Public PreviousTarget As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox Target.Cells.Count

'-- Customize BEGIN --------------------
  Const cStr1 = "Validation List Change"
  Const cStr2 = "Values have changed"
  Const cStr3 = "Previous Value"
  Const cStr4 = "Current Value"
'-- Customize END ----------------------

  Dim str1 As String

'Values in the NAMED RANGE (cStrValList)
  'Only if a cell in the named range has been 'addressed' i.e. a cell is
  'selected and you start typing or you click in the fomula bar, and then
  'enter is pressed, this will run which still doesn't mean the value has
  'been changed i.e. the same value has been written again... If the escape
  'key is used it doesn't run.
  If Not Intersect(Target, Range(cStrValList)) Is Nothing Then
    If Target.Cells.Count > 1 Then
      WSChange
      MsgBox "Cannot handle multiple cells, yet."
     Else
      'Check if the value has changed.
      If PreviousTarget <> Target.Value Then  'The value has changed.
        WSChange
        str1 = cStr1 & vbCrLf & vbCrLf & cStr2 & ":" & vbCrLf & vbCrLf & "'" & _
            Target.Address & "' " & cStr3 & " = '"
        str1 = str1 & PreviousTarget & "'" & vbCrLf & "'" & Target.Address
        str1 = str1 & "' " & cStr4 & " = '" & Target.Value & "'."
        MsgBox str1, vbInformation
       Else 'The value has not changed.
      End If
    End If
   Else 'The cell range is out of bounds.
  End If

'Values in the NAMED RANGE ROW outside the NAMED RANGE (cStrValList9
  Dim strOutside As String
  'Here comes some bad coding.
  strOutside = Range(cStrValList).Address
  strOutside = Split(strOutside, ":")(1)
  strOutside = Range(strOutside).Offset(0, 1).Address
  strOutside = strOutside & ":" _
      & Cells(Range(strOutside).Row, Columns.Count).Address
  If Not Intersect(Target, Range(strOutside)) Is Nothing Then
    If Target.Cells.Count > 1 Then
      WSChange
      MsgBox "Cannot handle multiple cells, yet."
     Else
      If PreviousTarget <> Target.Value Then 'The value has changed.
        If strMain <> "" Then
          WSChange
         Else
          MsgBox "You have to define a worksheet by name under 'cStrMain'."
        End If
      End If
    End If
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'This gets the 'previous' Target value. This is gold concerning the speed of
  'execution. It's a MUST REMEMBER.
  PreviousTarget = Target.Value
End Sub

Sub vallister()
  MsgBox Range(cStrValList).Address
End Sub
Sub sdaf()
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...