企业管理

开发平台：
Visual Basic

-：源码内容
							VERSION 5.00
Object = "{DD44C0E7-B2CF-11D1-8DD3-444553540000}#1.0#0"; "CELL32.OCX"
Begin VB.Form frm_sjzz 
   Caption         =   "数据转置"
   ClientHeight    =   4575
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6840
   HelpContextID   =   1014004
   Icon            =   "数据转置.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4575
   ScaleWidth      =   6840
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Caption         =   "公式选项"
      Height          =   1065
      Left            =   5400
      TabIndex        =   6
      Top             =   120
      Width           =   1335
      Begin VB.OptionButton Option2 
         Caption         =   "返回结果"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   630
         Width           =   1095
      End
      Begin VB.OptionButton Option1 
         Caption         =   "返回公式"
         Height          =   375
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Value           =   -1  'True
         Width           =   1095
      End
   End
   Begin VB.CommandButton Command5 
      Caption         =   "复原"
      Height          =   375
      Left            =   5550
      TabIndex        =   5
      Top             =   3180
      Width           =   1095
   End
   Begin VB.CommandButton Command4 
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   5550
      TabIndex        =   4
      Top             =   4080
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   5550
      TabIndex        =   3
      Top             =   3630
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "行反向"
      Height          =   375
      Left            =   5550
      TabIndex        =   2
      Top             =   2730
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "列反向"
      Height          =   375
      Left            =   5550
      TabIndex        =   1
      Top             =   2280
      Width           =   1095
   End
   Begin CELLLib.Cell Cell1 
      Height          =   4335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5175
      _Version        =   65536
      _ExtentX        =   9128
      _ExtentY        =   7646
      _StockProps     =   0
   End
End
Attribute VB_Name = "frm_sjzz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'*    模 块 名 称 :数据转置
'*    功 能 描 述 :
'*    程序员姓名  :奚俊峰
'*    最后修改人  :奚俊峰
'*    最后修改时间:2002/01/21
'***********************************************
Option Explicit
Private Sub Command1_Click()
    Dim i As Long, j As Long, ll_cols As Long, ll_rows As Long
    Dim lvar_data1, lvar_data2, ll_cell1 As Long, ll_cell2 As Long '标记是否为公式,0公式，1数据
    ll_cols = Cell1.Cols
    ll_rows = Cell1.Rows
    For i = 0 To ll_cols  2 - 1
        For j = 0 To ll_rows - 1
            
            If Cell1.IsFormulaCell(i, j) Then
                Cell1.DoGetFormula i, j, lvar_data1
                ll_cell1 = 0
            Else
                Cell1.DoGetCellData i, j, lvar_data1
                ll_cell1 = 1
            End If
            If Cell1.IsFormulaCell(ll_cols - i - 1, j) Then
                Cell1.DoGetFormula ll_cols - i - 1, j, lvar_data2
                ll_cell2 = 0
            Else
                Cell1.DoGetCellData ll_cols - i - 1, j, lvar_data2
                ll_cell2 = 1
            End If
            If ll_cell1 = 0 Then
                Cell1.DoClearCell ll_cols - i - 1, j, 0
                Cell1.DoSetFormula ll_cols - i - 1, j, lvar_data1
            Else
                If lvar_data1 = "" Then
                    Cell1.DoClearCell ll_cols - i - 1, j, 0
                    Cell1.DoClearCell ll_cols - i - 1, j, 0
                Else
                    Cell1.DoClearCell ll_cols - i - 1, j, 0
                    Cell1.DoSetCellData ll_cols - i - 1, j, lvar_data1
                End If
            End If
            If ll_cell2 = 0 Then
                Cell1.DoClearCell i, j, 0
                Cell1.DoSetFormula i, j, lvar_data2
            Else
                If lvar_data2 = "" Then
                    Cell1.DoClearCell i, j, 0
                    Cell1.DoClearCell i, j, 0
                Else
                    Cell1.DoClearCell i, j, 0
                    Cell1.DoSetCellData i, j, lvar_data2
                End If
            End If
            
        Next j
    Next i
    Cell1.DoCalculateAll
    Cell1.DoRedrawAll
End Sub
Private Sub command2_Click()
    Dim i As Long, j As Long, ll_cols As Long, ll_rows As Long
    Dim lvar_data1, lvar_data2, ll_cell1 As Long, ll_cell2 As Long '标记是否为公式,0公式，1数据
    ll_cols = Cell1.Cols
    ll_rows = Cell1.Rows
    For i = 0 To ll_rows  2 - 1
        For j = 0 To ll_cols - 1
            
            If Cell1.IsFormulaCell(j, i) Then
                Cell1.DoGetFormula j, i, lvar_data1
                ll_cell1 = 0
            Else
                Cell1.DoGetCellData j, i, lvar_data1
                ll_cell1 = 1
            End If
            If Cell1.IsFormulaCell(j, ll_rows - i - 1) Then
                Cell1.DoGetFormula j, ll_rows - i - 1, lvar_data2
                ll_cell2 = 0
            Else
                Cell1.DoGetCellData j, ll_rows - i - 1, lvar_data2
                ll_cell2 = 1
            End If
            If ll_cell1 = 0 Then
                Cell1.DoClearCell j, ll_rows - i - 1, 0
                Cell1.DoSetFormula j, ll_rows - i - 1, lvar_data1
            Else
                If lvar_data1 = "" Then
                    Cell1.DoClearCell j, ll_rows - i - 1, 0
                    Cell1.DoClearCell j, ll_rows - i - 1, 0
                Else
                    Cell1.DoClearCell j, ll_rows - i - 1, 0
                    Cell1.DoSetCellData j, ll_rows - i - 1, lvar_data1
                End If
            End If
            If ll_cell2 = 0 Then
                Cell1.DoClearCell j, i, 0
                Cell1.DoSetFormula j, i, lvar_data2
            Else
                If lvar_data2 = "" Then
                    Cell1.DoClearCell j, i, 0
                    Cell1.DoClearCell j, i, 0
                Else
                    Cell1.DoClearCell j, i, 0
                    Cell1.DoSetCellData j, i, lvar_data2
                End If
            End If
            
        Next j
    Next i
    Cell1.DoCalculateAll
    Cell1.DoRedrawAll
End Sub
Private Sub Command3_Click()
    Dim ll_col_begin, ll_row_begin
    Dim ll_col_end, ll_row_end
    Dim i As Long, j As Long
    Dim lvar_data
    With MDI_frame.ActiveForm
        .Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
        
        For i = 0 To ll_col_end - ll_col_begin
            For j = 0 To ll_row_end - ll_row_begin
                .Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
                .Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
                
                If Cell1.IsFormulaCell(i, j) And Option1.Value = True Then
                    Cell1.DoGetFormula i, j, lvar_data
                    .Cell1.DoSetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
                Else
                    Cell1.DoGetCellData i, j, lvar_data
                    If lvar_data = "" Then
                        .Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
                        .Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
                    Else
                        .Cell1.DoSetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
                    End If
                End If
            Next j
        Next i
        .Cell1.DoRedrawAll
    End With
    Unload Me
    
End Sub
Private Sub Command4_Click()
    Unload Me
    
End Sub
Private Sub Command5_Click()
    Dim ll_col_begin, ll_row_begin
    Dim ll_col_end, ll_row_end
    Dim i As Long, j As Long
    Dim lvar_data
    Cell1.CalcManaually = 0
    With MDI_frame.ActiveForm
        .Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
        For i = 0 To ll_col_end - ll_col_begin
            For j = 0 To ll_row_end - ll_row_begin
                If .Cell1.IsFormulaCell(i + ll_col_begin, j + ll_row_begin) Then
                    .Cell1.DoGetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
                    Cell1.DoSetFormula i, j, lvar_data
                Else
                    .Cell1.DoGetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
                    If lvar_data = "" Then
                        Cell1.DoClearCell i, j, 0
                        Cell1.DoClearCell i, j, 0
                    Else
                        Cell1.DoSetCellData i, j, lvar_data
                    End If
                End If
            Next j
        Next i
    End With
    Cell1.DoRedrawAll
End Sub
Private Sub Form_Load()
    Dim ll_col_begin, ll_row_begin
    Dim ll_col_end, ll_row_end
    Dim i As Long, j As Long
    Dim lvar_data
    Cell1.CalcManaually = 0
    With MDI_frame.ActiveForm
        .Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
        Cell1.Cols = ll_col_end - ll_col_begin + 1
        Cell1.Rows = ll_row_end - ll_row_begin + 1
        
        For i = 0 To ll_col_end - ll_col_begin
            For j = 0 To ll_row_end - ll_row_begin
                If .Cell1.IsFormulaCell(i + ll_col_begin, j + ll_row_begin) Then
                    .Cell1.DoGetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
                    Cell1.DoSetFormula i, j, lvar_data
                Else
                    .Cell1.DoGetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
                    If lvar_data <> "" Then
                        Cell1.DoSetCellData i, j, lvar_data
                    End If
                End If
            Next j
        Next i
    End With
End Sub

						